diff -Nru libdbd-sybase-perl-1.09/BUGS libdbd-sybase-perl-1.14/BUGS --- libdbd-sybase-perl-1.09/BUGS 2001-07-03 15:55:20.000000000 +0000 +++ libdbd-sybase-perl-1.14/BUGS 2011-10-02 14:09:15.000000000 +0000 @@ -1,4 +1,4 @@ -$Id: BUGS,v 1.1 2001/07/03 15:55:20 mpeppler Exp $ +$Id: BUGS,v 1.3 2011/09/06 17:26:01 mpeppler Exp $ Known problems: -------------- diff -Nru libdbd-sybase-perl-1.09/CHANGES libdbd-sybase-perl-1.14/CHANGES --- libdbd-sybase-perl-1.09/CHANGES 2008-08-31 12:08:17.000000000 +0000 +++ libdbd-sybase-perl-1.14/CHANGES 2011-10-02 15:03:28.000000000 +0000 @@ -1,4 +1,39 @@ -$Id: CHANGES,v 1.81 2008/08/31 12:08:17 mpeppler Exp $ +$Id: CHANGES,v 1.88 2011/10/02 15:03:17 mpeppler Exp $ + +Release 1.14 + + Fix bad size handling for unicode data. + Remove default charset setting to utf8 (this had been done in 1.11 as part of + improved utf8 handling, but has negative side-effects. If unicode handling is needed + then set "charset=utf8" as part of the connection string. + Enforce the fact that utf8/unicode handling only works with OpenClient 15.x or later. + +Release 1.13 + + Fix for incorrect UTF8 handling when retrieving UNICODE data (Jean-Pierre Rupp). + +Release 1.12 + + Bug/Typo/Compatibility fixes with various versions of OpenClient. + Experimental: Handle in/out parameters (Merijn Broeren) + +Release 1.11 + + Remove reliance on PERL_POLLUTE. + Add better support for utf8 (Dave Rolsky) + +Release 1.10 + + Handle 15.x datatypes correctly. + Add LONGMS date format symbol to handle microseconds for bigdatetime. + Add support for CS_LONGCHAR_TYPE (Mark Aufflick) + Document syb_isdead(). + Handle 64bit builds with FreeTDS (Ian Grant/Hans Kristian Rosbach) + Add foreign_key_info & statistics_info (Jim Radford) + Change behavior of large fixed precision numeric types (money, bigint) + to be converted to a string internally and returned as such to the caller + (behavior similar to numeric/decimal). This can be reverted to the old behavior + by defining SYB_NATIVE_NUM. Release 1.09 diff -Nru libdbd-sybase-perl-1.09/dbdimp.c libdbd-sybase-perl-1.14/dbdimp.c --- libdbd-sybase-perl-1.09/dbdimp.c 2011-11-19 12:00:57.000000000 +0000 +++ libdbd-sybase-perl-1.14/dbdimp.c 2011-10-02 14:56:17.000000000 +0000 @@ -1,6 +1,6 @@ -/* $Id: dbdimp.c,v 1.101 2008/08/31 12:08:17 mpeppler Exp $ +/* $Id: dbdimp.c,v 1.113 2011/10/02 14:54:07 mpeppler Exp $ - Copyright (c) 1997-2008 Michael Peppler + Copyright (c) 1997-2011 Michael Peppler You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. @@ -8,27 +8,19 @@ Based on DBD::Oracle dbdimp.c, Copyright (c) 1994,1995 Tim Bunce */ - #include "Sybase.h" - /* Defines needed for perl 5.005 / threading */ - #if defined(op) #undef op #endif - #if !defined(PATCHLEVEL) #include "patchlevel.h" /* this is the perl patchlevel.h */ #endif - #if PATCHLEVEL < 5 && SUBVERSION < 5 - #define PL_na na #define PL_sv_undef sv_undef #define PL_dirty dirty - #endif - #ifndef PerlIO # define PerlIO FILE # define PerlIO_printf fprintf @@ -38,17 +30,14 @@ # define PerlIO_flush(f) fflush(f) # define PerlIO_puts(f,s) fputs(s,f) #endif - /* Requested by Alex Fridman */ #ifdef WIN32 # define strncasecmp _strnicmp #endif - /*#define NO_CHAINED_TRAN 1*/ #if !defined(NO_CHAINED_TRAN) #define NO_CHAINED_TRAN 0 #endif - /* some systems have trouble with ct_cancel(). If FLUSH_FINISH is 1 then the default behavior is to fetch all results from the server when $sth->finish() is called instead of the normal @@ -56,11 +45,54 @@ #if !defined(FLUSH_FINISH) #define FLUSH_FINISH 0 #endif - #if !defined(PROC_STATUS) #define PROC_STATUS 0 #endif - +/* + * In DBD::Sybase 1.09 and before, certain large numeric types (money, bigint) + * were being kept in native format, and then returned to the caller as a perl NV + * data item. An NV is really a float, so there was loss of precision, especially for bigint + * data which is a 64bit int. + * In 1.10 these datatypes behave the same way as numeric/decimal - converted to a char string + * and returned that way to the caller, who can then use Math::BigInt, etc. + * If you want to revert to the previous behavior, you need to define SYB_NATIVE_NUM. + * + * #define SYB_NATIVE_NUM + */ +/* FreeTDS doesn't always define these symbols */ +#if defined(CS_VERSION_110) +#if !defined BLK_VERSION_110 +#define BLK_VERSION_110 BLK_VERSION_100 +#endif +#endif +#if defined(CS_VERSION_120) +#if !defined BLK_VERSION_120 +#define BLK_VERSION_120 BLK_VERSION_110 +#endif +#endif +#if defined(CS_VERSION_125) +#if !defined BLK_VERSION_125 +#define BLK_VERSION_125 BLK_VERSION_120 +#endif +#endif +#if defined(CS_VERSION_150) +#if !defined BLK_VERSION_150 +#define BLK_VERSION_150 BLK_VERSION_125 +#endif +#endif +#if defined(CS_VERSION_155) +#if !defined BLK_VERSION_155 +#define BLK_VERSION_155 BLK_VERSION_150 +#endif +#endif +#if defined(CS_VERSION_157) +#if !defined BLK_VERSION_157 +#define BLK_VERSION_157 BLK_VERSION_155 +#endif +#endif +#if !defined(CS_LONGCHAR_TYPE) +#define CS_LONGCHAR_TYPE CS_CHAR_TYPE +#endif DBISTATE_DECLARE; static void cleanUp _((imp_sth_t *)); @@ -72,7 +104,8 @@ static CS_RETCODE fetch_data _((imp_dbh_t *, CS_COMMAND*)); static CS_RETCODE CS_PUBLIC clientmsg_cb _((CS_CONTEXT*, CS_CONNECTION*, CS_CLIENTMSG*)); static CS_RETCODE CS_PUBLIC servermsg_cb _((CS_CONTEXT*, CS_CONNECTION*, CS_SERVERMSG*)); -static CS_RETCODE CS_PUBLIC cslibmsg_cb(CS_CONTEXT *context, CS_CLIENTMSG *errmsg); +static CS_RETCODE CS_PUBLIC cslibmsg_cb(CS_CONTEXT *context, + CS_CLIENTMSG *errmsg); static CS_COMMAND *syb_alloc_cmd _((imp_dbh_t *, CS_CONNECTION*)); static void dealloc_dynamic _((imp_sth_t *)); static int map_syb_types _((int)); @@ -90,13 +123,16 @@ static int datetime2str(CS_DATETIME *dt, CS_DATAFMT *srcfmt, char *buff, CS_INT len, int type, CS_LOCALE *locale); #if defined(CS_DATE_TYPE) -static int date2str(CS_DATE *dt, CS_DATAFMT *srcfmt, - char *buff, CS_INT len, int type, CS_LOCALE *locale); -static int time2str(CS_TIME *dt, CS_DATAFMT *srcfmt, - char *buff, CS_INT len, int type, CS_LOCALE *locale); +static int date2str(CS_DATE *dt, CS_DATAFMT *srcfmt, char *buff, CS_INT len, + int type, CS_LOCALE *locale); +static int time2str(CS_TIME *dt, CS_DATAFMT *srcfmt, char *buff, CS_INT len, + int type, CS_LOCALE *locale); #endif static int syb_get_date_fmt(imp_dbh_t *imp_dbh, char *fmt); static int cmd_execute(SV *sth, imp_sth_t *imp_sth); +#if defined(DBD_CAN_HANDLE_UTF8) +static int is_high_bit_set(const unsigned char *val, STRLEN size); +#endif static CS_BINARY *to_binary(char *str, STRLEN *outlen); static int get_server_version(SV *dbh, imp_dbh_t *imp_dbh, CS_CONNECTION *con); static void clear_cache(SV *sth, imp_sth_t *imp_sth); @@ -124,7 +160,8 @@ static int syb_set_options(imp_dbh_t *imp_dbh, CS_INT action, CS_INT option, CS_VOID *value, CS_INT len, CS_INT *outlen) { if (DBIc_DBISTATE(imp_dbh)->debug >= 5) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_set_options: optSupported = %d\n", + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_set_options: optSupported = %d\n", imp_dbh->optSupported); if (!imp_dbh->optSupported) @@ -143,8 +180,7 @@ } static CS_RETCODE CS_PUBLIC -cslibmsg_cb(CS_CONTEXT *context, CS_CLIENTMSG *errmsg) -{ +cslibmsg_cb(CS_CONTEXT *context, CS_CLIENTMSG *errmsg) { dTHX; #if 0 @@ -156,8 +192,7 @@ } #endif - if(cslib_cb) - { + if (cslib_cb) { dSP; int retval, count; @@ -170,13 +205,13 @@ XPUSHs(sv_2mortal(newSViv(CS_SEVERITY(errmsg->msgnumber)))); XPUSHs(sv_2mortal(newSViv(CS_NUMBER(errmsg->msgnumber)))); XPUSHs(sv_2mortal(newSVpv(errmsg->msgstring, 0))); - if (errmsg->osstringlen> 0) + if (errmsg->osstringlen > 0) XPUSHs(sv_2mortal(newSVpv(errmsg->osstring, 0))); else XPUSHs(&PL_sv_undef); PUTBACK; - if((count = perl_call_sv(cslib_cb, G_SCALAR)) != 1) + if ((count = perl_call_sv(cslib_cb, G_SCALAR)) != 1) croak("A cslib handler cannot return a LIST"); SPAGAIN; retval = POPi; @@ -187,17 +222,14 @@ return retval; } - PerlIO_printf(PerlIO_stderr(), - "\nCS Library Message:\n"); + PerlIO_printf(PerlIO_stderr(), "\nCS Library Message:\n"); PerlIO_printf(PerlIO_stderr(), "Message number: LAYER = (%ld) ORIGIN = (%ld) ", CS_LAYER(errmsg->msgnumber), CS_ORIGIN(errmsg->msgnumber)); PerlIO_printf(PerlIO_stderr(), "SEVERITY = (%ld) NUMBER = (%ld)\n", - CS_SEVERITY(errmsg->msgnumber), - CS_NUMBER(errmsg->msgnumber)); + CS_SEVERITY(errmsg->msgnumber), CS_NUMBER(errmsg->msgnumber)); PerlIO_printf(PerlIO_stderr(), "Message String: %s\n", errmsg->msgstring); - if (errmsg->osstringlen> 0) - { + if (errmsg->osstringlen > 0) { PerlIO_printf(PerlIO_stderr(), "Operating System Error: %s\n", errmsg->osstring); } @@ -207,16 +239,15 @@ static CS_RETCODE CS_PUBLIC clientmsg_cb(CS_CONTEXT *context, CS_CONNECTION *connection, - CS_CLIENTMSG *errmsg) -{ + CS_CLIENTMSG *errmsg) { dTHX; imp_dbh_t *imp_dbh = NULL; char buff[255]; - if(connection) { - if((ct_con_props(connection, CS_GET, CS_USERDATA, - &imp_dbh, CS_SIZEOF(imp_dbh), NULL)) != CS_SUCCEED) - croak("Panic: clientmsg_cb: Can't find handle from connection"); + if (connection) { + if ((ct_con_props(connection, CS_GET, CS_USERDATA, &imp_dbh, + CS_SIZEOF(imp_dbh), NULL)) != CS_SUCCEED) + croak("Panic: clientmsg_cb: Can't find handle from connection"); if(DBIc_DBISTATE(imp_dbh)->debug >= 4) { PerlIO_printf(DBIc_LOGPIO(imp_dbh), " clientmsg_cb -> %s\n", @@ -230,7 +261,7 @@ /* if LongTruncOK is set then ignore this error. */ if(DBIc_is(imp_dbh, DBIcf_LongTruncOk) && CS_NUMBER(errmsg->msgnumber) == 132) - return CS_SUCCEED; + return CS_SUCCEED; if(imp_dbh->err_handler) { dSP; @@ -248,15 +279,15 @@ XPUSHs(&PL_sv_undef); XPUSHs(sv_2mortal(newSVpv(errmsg->msgstring, 0))); if(imp_dbh->sql) - XPUSHs(sv_2mortal(newSVpv(imp_dbh->sql, 0))); + XPUSHs(sv_2mortal(newSVpv(imp_dbh->sql, 0))); else - XPUSHs(&PL_sv_undef); + XPUSHs(&PL_sv_undef); XPUSHs(sv_2mortal(newSVpv("client", 0))); PUTBACK; if((count = perl_call_sv(imp_dbh->err_handler, G_SCALAR | G_EVAL)) != 1) - croak("An error handler can't return a LIST."); + croak("An error handler can't return a LIST."); SPAGAIN; if(SvTRUE(ERRSV)) { @@ -272,15 +303,15 @@ /* If the called sub returns 0 then ignore this error */ if(retval == 0) - return CS_SUCCEED; + return CS_SUCCEED; } sv_setiv(DBIc_ERR(imp_dbh), (IV)CS_NUMBER(errmsg->msgnumber)); if(SvOK(DBIc_ERRSTR(imp_dbh))) - sv_catpv(DBIc_ERRSTR(imp_dbh), "OpenClient message: "); + sv_catpv(DBIc_ERRSTR(imp_dbh), "OpenClient message: "); else - sv_setpv(DBIc_ERRSTR(imp_dbh), "OpenClient message: "); + sv_setpv(DBIc_ERRSTR(imp_dbh), "OpenClient message: "); sprintf(buff, "LAYER = (%ld) ORIGIN = (%ld) ", CS_LAYER(errmsg->msgnumber), CS_ORIGIN(errmsg->msgnumber)); sv_catpv(DBIc_ERRSTR(imp_dbh), buff); @@ -318,8 +349,8 @@ status = 0; if (ct_con_props(connection, CS_GET, CS_LOGIN_STATUS, - (CS_VOID *)&status, - CS_UNUSED, NULL) != CS_SUCCEED) { + (CS_VOID *)&status, + CS_UNUSED, NULL) != CS_SUCCEED) { imp_dbh->isDead = 1; return CS_FAIL; } @@ -353,8 +384,7 @@ static CS_RETCODE CS_PUBLIC servermsg_cb(CS_CONTEXT *context, CS_CONNECTION *connection, - CS_SERVERMSG *srvmsg) -{ + CS_SERVERMSG *srvmsg) { CS_COMMAND *cmd; CS_RETCODE retcode; imp_dbh_t *imp_dbh = NULL; @@ -364,13 +394,13 @@ /* add check on connection not being NULL (PR/477) just to be on the safe side - freetds can call the server callback with a NULL connection */ - if(connection && (ct_con_props(connection, CS_GET, CS_USERDATA, - &imp_dbh, CS_SIZEOF(imp_dbh), NULL)) != CS_SUCCEED) - croak("Panic: servermsg_cb: Can't find handle from connection"); - - if(imp_dbh && DBIc_DBISTATE(imp_dbh)->debug >= 4) { - if(srvmsg->msgnumber) { - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " servermsg_cb -> number=%ld severity=%ld ", + if (connection && (ct_con_props(connection, CS_GET, CS_USERDATA, &imp_dbh, + CS_SIZEOF(imp_dbh), NULL)) != CS_SUCCEED) + croak("Panic: servermsg_cb: Can't find handle from connection"); + + if(imp_dbh && DBIc_DBISTATE(imp_dbh)->debug >= 4) { + if(srvmsg->msgnumber) { + PerlIO_printf(DBIc_LOGPIO(imp_dbh)," servermsg_cb -> number=%ld severity=%ld ", srvmsg->msgnumber, srvmsg->severity); PerlIO_printf(DBIc_LOGPIO(imp_dbh), "state=%ld line=%ld ", srvmsg->state, srvmsg->line); @@ -541,7 +571,7 @@ else retcode = CS_SUCCEED; - sv_catpv(DBIc_ERRSTR(imp_dbh), "\n"); + sv_catpv(DBIc_ERRSTR(imp_dbh), " "); return retcode; } else { @@ -570,7 +600,7 @@ static CS_CHAR * GetAggOp(CS_INT op) { CS_CHAR *name; - switch ((int)op) { + switch ((int) op) { case CS_OP_SUM: name = "sum"; break; @@ -598,15 +628,20 @@ switch ((int) column->datatype) { case CS_CHAR_TYPE: + case CS_LONGCHAR_TYPE: case CS_VARCHAR_TYPE: case CS_TEXT_TYPE: case CS_IMAGE_TYPE: - len = column->maxlength; + len = column->maxlength; break; case CS_BINARY_TYPE: case CS_VARBINARY_TYPE: case CS_LONGBINARY_TYPE: +//#if defined(CS_UNICHAR_TYPE) +// case CS_UNICHAR_TYPE: +// case CS_UNITEXT_TYPE: +//#endif len = (2 * column->maxlength) + 2; break; @@ -616,13 +651,25 @@ break; case CS_SMALLINT_TYPE: +#if defined(CS_USMALLINT_TYPE) + case CS_USMALLINT_TYPE: +#endif len = 6; break; case CS_INT_TYPE: +#if defined(CS_UINT_TYPE) + case CS_UINT_TYPE: +#endif len = 11; break; +#if defined(CS_BIGINT_TYPE) + case CS_BIGINT_TYPE: + case CS_UBIGINT_TYPE: + len = 22; +#endif + case CS_REAL_TYPE: case CS_FLOAT_TYPE: len = 20; @@ -639,16 +686,15 @@ case CS_DATE_TYPE: case CS_TIME_TYPE: #endif - len = 30; - break; - - case CS_NUMERIC_TYPE: - case CS_DECIMAL_TYPE: - len = (CS_MAX_PREC + 2); +#if defined(CS_BIGDATETIME_TYPE) + case CS_BIGDATETIME_TYPE: + case CS_BIGTIME_TYPE: +#endif + len = 40; break; #ifdef CS_UNIQUE_TYPE - case CS_UNIQUE_TYPE: + case CS_UNIQUE_TYPE: len = 40; break; #endif @@ -668,6 +714,7 @@ switch ((int) column->datatype) { case CS_CHAR_TYPE: + case CS_LONGCHAR_TYPE: case CS_VARCHAR_TYPE: case CS_TEXT_TYPE: case CS_IMAGE_TYPE: @@ -739,26 +786,33 @@ sigprocmask(SIG_BLOCK, &set, NULL); #endif +#if defined(CS_CURRENT_VERSION) + if (retcode != CS_SUCCEED) { + cs_ver = CS_CURRENT_VERSION; + retcode = cs_ctx_alloc(cs_ver, &context); + } +#endif + #if defined(CS_VERSION_150) - if(retcode != CS_SUCCEED) { + if (retcode != CS_SUCCEED) { cs_ver = CS_VERSION_150; retcode = cs_ctx_alloc(cs_ver, &context); } #endif #if defined(CS_VERSION_125) - if(retcode != CS_SUCCEED) { + if (retcode != CS_SUCCEED) { cs_ver = CS_VERSION_125; retcode = cs_ctx_alloc(cs_ver, &context); } #endif #if defined(CS_VERSION_120) - if(retcode != CS_SUCCEED) { + if (retcode != CS_SUCCEED) { cs_ver = CS_VERSION_120; retcode = cs_ctx_alloc(cs_ver, &context); } #endif #if defined(CS_VERSION_110) - if(retcode != CS_SUCCEED) { + if (retcode != CS_SUCCEED) { cs_ver = CS_VERSION_110; retcode = cs_ctx_alloc(cs_ver, &context); } @@ -772,30 +826,32 @@ if (retcode != CS_SUCCEED) croak("DBD::Sybase initialize: cs_ctx_alloc(%d) failed", cs_ver); -#if !defined(NO_BLK) +#if defined(CS_CURRENT_VERSION) + if (cs_ver = CS_CURRENT_VERSION) + BLK_VERSION = CS_CURRENT_VERSION; +#endif #if defined(CS_VERSION_150) - if(cs_ver == CS_VERSION_150) + if (cs_ver == CS_VERSION_150) BLK_VERSION = BLK_VERSION_150; #endif #if defined(CS_VERSION_125) - if(cs_ver == CS_VERSION_125) + if (cs_ver == CS_VERSION_125) BLK_VERSION = BLK_VERSION_125; #endif #if defined(CS_VERSION_120) - if(cs_ver == CS_VERSION_120) + if (cs_ver == CS_VERSION_120) BLK_VERSION = BLK_VERSION_120; #endif #if defined(CS_VERSION_110) - if(cs_ver == CS_VERSION_110) + if (cs_ver == CS_VERSION_110) BLK_VERSION = BLK_VERSION_110; #endif -#endif if (cs_ver == CS_VERSION_100) BLK_VERSION = BLK_VERSION_100; #if USE_CSLIB_CB if (cs_config(context, CS_SET, CS_MESSAGE_CB, - (CS_VOID *)cslibmsg_cb, CS_UNUSED, NULL) != CS_SUCCEED) { + (CS_VOID *)cslibmsg_cb, CS_UNUSED, NULL) != CS_SUCCEED) { /* Release the context structure. */ (void)cs_ctx_drop(context); @@ -807,7 +863,8 @@ #endif #if defined(CS_EXTERNAL_CONFIG) - if(cs_config(context, CS_SET, CS_EXTERNAL_CONFIG, &boolean, CS_UNUSED, NULL) != CS_SUCCEED) { + if (cs_config(context, CS_SET, CS_EXTERNAL_CONFIG, &boolean, CS_UNUSED, + NULL) != CS_SUCCEED) { /* Ignore this error... */ /* warn("Can't set CS_EXTERNAL_CONFIG to false"); */ } @@ -822,10 +879,10 @@ } if ((retcode = ct_callback(context, NULL, CS_SET, CS_CLIENTMSG_CB, - (CS_VOID *)clientmsg_cb)) != CS_SUCCEED) + (CS_VOID *) clientmsg_cb)) != CS_SUCCEED) croak("DBD::Sybase initialize: ct_callback(clientmsg) failed"); if ((retcode = ct_callback(context, NULL, CS_SET, CS_SERVERMSG_CB, - (CS_VOID *)servermsg_cb)) != CS_SUCCEED) + (CS_VOID *) servermsg_cb)) != CS_SUCCEED) croak("DBD::Sybase initialize: ct_callback(servermsg) failed"); if ((retcode = ct_config(context, CS_SET, CS_NETIO, &netio_type, CS_UNUSED, @@ -835,13 +892,13 @@ #if defined(MAX_CONNECT) netio_type = MAX_CONNECT; if((retcode = ct_config(context, CS_SET, CS_MAX_CONNECT, &netio_type, - CS_UNUSED, NULL)) != CS_SUCCEED) - croak("DBD::Sybase initialize: ct_config(max_connect) failed"); + CS_UNUSED, NULL)) != CS_SUCCEED) + croak("DBD::Sybase initialize: ct_config(max_connect) failed"); #endif { char out[1024], *p; - retcode = ct_config(context, CS_GET, CS_VER_STRING, (CS_VOID*)out, + retcode = ct_config(context, CS_GET, CS_VER_STRING, (CS_VOID*) out, 1024, &outlen); if ((p = strchr(out, '\n'))) *p = 0; @@ -874,8 +931,10 @@ if ((sv = perl_get_sv("DBD::Sybase::VERSION", FALSE))) p = SvPV(sv, lna); - PerlIO_printf(dbistate->logfp, " syb_init() -> DBD::Sybase %s initialized\n", p); - PerlIO_printf(dbistate->logfp, " OpenClient version: %s\n", ocVersion); + PerlIO_printf(dbistate->logfp, + " syb_init() -> DBD::Sybase %s initialized\n", p); + PerlIO_printf(dbistate->logfp, " OpenClient version: %s\n", + ocVersion); } if ((retcode = cs_loc_alloc(context, &locale)) != CS_SUCCEED) { @@ -883,21 +942,31 @@ } if (retcode == CS_SUCCEED) { if ((retcode = cs_locale(context, CS_SET, locale, CS_LC_ALL, - (CS_CHAR*)NULL, CS_UNUSED, (CS_INT*)NULL)) != CS_SUCCEED) { + (CS_CHAR*) NULL, CS_UNUSED, (CS_INT*) NULL)) != CS_SUCCEED) { warn("cs_locale(CS_LC_ALL) failed"); } } + /* Set default charset to utf8. The charset can still be overridden + * via the charset=xxxx connection attribute. + */ +/* if (retcode == CS_SUCCEED) { + if ((retcode = cs_locale(context, CS_SET, locale, CS_SYB_CHARSET, + "utf8", CS_NULLTERM, NULL)) != CS_SUCCEED) { + warn("cs_locale(CS_SYB_CHARSET) failed"); + } + }*/ + if (retcode == CS_SUCCEED) { CS_INT type = CS_DATES_SHORT; if ((retcode = cs_dt_info(context, CS_SET, locale, CS_DT_CONVFMT, - CS_UNUSED, (CS_VOID*)&type, CS_SIZEOF(CS_INT), NULL)) + CS_UNUSED, (CS_VOID*) &type, CS_SIZEOF(CS_INT), NULL)) != CS_SUCCEED) - warn("cs_dt_info() failed"); - } + warn("cs_dt_info() failed"); + } - if (retcode == CS_SUCCEED) { - if ((retcode = cs_config(context, CS_SET, CS_LOC_PROP, locale, + if (retcode == CS_SUCCEED) { + if ((retcode = cs_config(context, CS_SET, CS_LOC_PROP, locale, CS_UNUSED, NULL)) != CS_SUCCEED) { /* warn("cs_config(CS_LOC_PROP) failed"); */ } @@ -923,7 +992,8 @@ /* XXX: DBIS and DBILOGFP need to be fixed */ if (DBIS->debug >= 3) - PerlIO_printf(DBILOGFP, " syb_set_timeout() -> ct_config(CS_TIMEOUT,%d)\n", timeout); + PerlIO_printf(DBILOGFP, + " syb_set_timeout() -> ct_config(CS_TIMEOUT,%d)\n", timeout); #if PERL_VERSION >= 8 && defined(_REENTRANT) MUTEX_LOCK (context_alloc_mutex); @@ -957,7 +1027,7 @@ dTHX; if (attribs) { SV **svp; - if ((svp = hv_fetch((HV*)SvRV(attribs), key, strlen(key), 0)) != NULL) { + if ((svp = hv_fetch((HV*) SvRV(attribs), key, strlen(key), 0)) != NULL) { return SvIV(*svp); } } @@ -969,7 +1039,7 @@ if (attribs) { SV **svp; - if ((svp = hv_fetch((HV*)SvRV(attribs), key, strlen(key), 0)) != NULL) { + if ((svp = hv_fetch((HV*) SvRV(attribs), key, strlen(key), 0)) != NULL) { return newSVsv(*svp); } } @@ -984,7 +1054,7 @@ if (!attribs || !SvOK(attribs)) { return; } - if ((svp = hv_fetch((HV*)SvRV(attribs), BCP_ATTRIB, strlen(BCP_ATTRIB), 0)) + if ((svp = hv_fetch((HV*) SvRV(attribs), BCP_ATTRIB, strlen(BCP_ATTRIB), 0)) != NULL) { imp_sth->bcpFlag = 1; imp_sth->bcpIdentityFlag = fetchAttrib(*svp, "identity_flag"); @@ -1032,10 +1102,18 @@ imp_dbh->kerberosPrincipal[0] = 0; imp_dbh->kerbGetTicket = fetchSvAttrib(attribs, "syb_kerberos_serverprincipal"); - imp_dbh->disconnectInChild = fetchAttrib(attribs, - "syb_disconnect_in_child"); + imp_dbh->disconnectInChild + = fetchAttrib(attribs, "syb_disconnect_in_child"); imp_dbh->host[0] = 0; imp_dbh->port[0] = 0; + imp_dbh->enable_utf8 = fetchAttrib(attribs, "syb_enable_utf8"); +#if !defined(DBD_CAN_HANDLE_UTF8) + if (imp_dbh->enable_utf8) { + warn("The current version of OpenClient can't handle utf8 data."); + } + imp_dbh->enable_utf8 = 0; +#endif + imp_dbh->blkLogin[0] = 0; @@ -1079,7 +1157,7 @@ if (imp_dbh->kerbGetTicket) { fetchKerbTicket(imp_dbh); } - + imp_dbh->pid = getpid(); #if PERL_VERSION >= 8 && defined(_REENTRANT) @@ -1121,7 +1199,7 @@ Ed Avis */ if (imp_dbh->maxConnect[0]) { /* Maximum number of connections. */ - const char *const s = imp_dbh->maxConnect; + const char * const s = imp_dbh->maxConnect; int i; i = atoi(s); @@ -1130,8 +1208,8 @@ return 0; } #if defined(CS_MAX_CONNECT) - if((retcode = ct_config(context, CS_SET, CS_MAX_CONNECT, (CS_VOID*)&i, - CS_UNUSED, NULL)) != CS_SUCCEED) + if ((retcode = ct_config(context, CS_SET, CS_MAX_CONNECT, + (CS_VOID*) &i, CS_UNUSED, NULL)) != CS_SUCCEED) croak("ct_config(max_connect) failed"); #else warn("ct_config(max_connect) not supported"); @@ -1139,7 +1217,8 @@ } if (imp_dbh->ifile[0]) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_login() -> ct_config(CS_IFILE,%s)\n", + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_login() -> ct_config(CS_IFILE,%s)\n", imp_dbh->ifile); if ((retcode = ct_config(context, CS_GET, CS_IFILE, ofile, 255, NULL)) != CS_SUCCEED) @@ -1158,7 +1237,9 @@ timeout = 60; /* set negative or 0 length timeout to default 60 seconds */ if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_login() -> ct_config(CS_LOGIN_TIMEOUT,%d)\n", timeout); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_login() -> ct_config(CS_LOGIN_TIMEOUT,%d)\n", + timeout); if ((retcode = ct_config(context, CS_SET, CS_LOGIN_TIMEOUT, &timeout, CS_UNUSED, NULL)) != CS_SUCCEED) warn("ct_config(CS_SET, CS_LOGIN_TIMEOUT) failed"); @@ -1169,7 +1250,8 @@ timeout = CS_NO_LIMIT; /* set negative or 0 length timeout to default no limit */ if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_login() -> ct_config(CS_TIMEOUT,%d)\n", timeout); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_login() -> ct_config(CS_TIMEOUT,%d)\n", timeout); if ((retcode = ct_config(context, CS_SET, CS_TIMEOUT, &timeout, CS_UNUSED, NULL)) != CS_SUCCEED) warn("ct_config(CS_SET, CS_TIMEOUT) failed"); @@ -1179,22 +1261,25 @@ CS_INT type = CS_DATES_SHORT; if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_login() -> using private CS_LOCALE data\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_login() -> using private CS_LOCALE data\n"); /* Set up the proper locale - to handle character sets, etc. */ if ((retcode = cs_loc_alloc(context, &imp_dbh->locale) != CS_SUCCEED)) { warn("cs_loc_alloc failed"); return 0; } if (cs_locale(context, CS_SET, imp_dbh->locale, CS_LC_ALL, - (CS_CHAR*)NULL, CS_UNUSED, (CS_INT*)NULL) != CS_SUCCEED) { + (CS_CHAR*) NULL, CS_UNUSED, (CS_INT*) NULL) != CS_SUCCEED) { warn("cs_locale(CS_LC_ALL) failed"); return 0; } if (imp_dbh->language[0] != 0) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_login() -> cs_locale(CS_SYB_LANG,%s)\n", imp_dbh->language); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_login() -> cs_locale(CS_SYB_LANG,%s)\n", + imp_dbh->language); if (cs_locale(context, CS_SET, imp_dbh->locale, CS_SYB_LANG, - (CS_CHAR*)imp_dbh->language, CS_NULLTERM, (CS_INT*)NULL) + (CS_CHAR*) imp_dbh->language, CS_NULLTERM, (CS_INT*) NULL) != CS_SUCCEED) { warn("cs_locale(CS_SYB_LANG, %s) failed", imp_dbh->language); return 0; @@ -1202,9 +1287,11 @@ } if (imp_dbh->charset[0] != 0) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_login() -> cs_locale(CS_SYB_CHARSET,%s)\n", imp_dbh->charset); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_login() -> cs_locale(CS_SYB_CHARSET,%s)\n", + imp_dbh->charset); if (cs_locale(context, CS_SET, imp_dbh->locale, CS_SYB_CHARSET, - (CS_CHAR*)imp_dbh->charset, CS_NULLTERM, (CS_INT*)NULL) + (CS_CHAR*) imp_dbh->charset, CS_NULLTERM, (CS_INT*) NULL) != CS_SUCCEED) { warn("cs_locale(CS_SYB_CHARSET, %s) failed", imp_dbh->charset); return 0; @@ -1212,288 +1299,288 @@ } if (cs_dt_info(context, CS_SET, imp_dbh->locale, CS_DT_CONVFMT, - CS_UNUSED, (CS_VOID*)&type, CS_SIZEOF(CS_INT), NULL) + CS_UNUSED, (CS_VOID*) &type, CS_SIZEOF(CS_INT), NULL) != CS_SUCCEED) - warn("cs_dt_info() failed"); + warn("cs_dt_info() failed"); - } else { - if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_login() -> using global CS_LOCALE data\n"); + } else { + if (DBIc_DBISTATE(imp_dbh)->debug >= 3) + PerlIO_printf(DBIc_LOGPIO(imp_dbh)," syb_db_login() -> using global CS_LOCALE data\n"); } #if defined(CS_CON_KEEPALIVE) - if (imp_dbh->tds_keepalive[0]) { - int tds_keepalive = atoi(imp_dbh->tds_keepalive); + if (imp_dbh->tds_keepalive[0]) { + int tds_keepalive = atoi(imp_dbh->tds_keepalive); - if (tds_keepalive != 1) { - tds_keepalive = 0; - } + if (tds_keepalive != 1) { + tds_keepalive = 0; + } - if(DBIc_DBISTATE(imp_dbh)->debug >= 3) + if(DBIc_DBISTATE(imp_dbh)->debug >= 3) PerlIO_printf(DBIc_LOGPIO(imp_dbh), "syb_db_login() -> ct_config(CS_CON_KEEPALIVE,%d)\n", tds_keepalive); - if((retcode = ct_config(context, CS_SET, CS_CON_KEEPALIVE, &tds_keepalive, CS_UNUSED, NULL)) != CS_SUCCEED) + if((retcode = ct_config(context, CS_SET, CS_CON_KEEPALIVE, &tds_keepalive, CS_UNUSED, NULL)) != CS_SUCCEED) warn("ct_config(CS_SET, CS_CON_KEEPALIVE) failed"); - } + } #endif - if ((retcode = ct_con_alloc(context, &connection)) != CS_SUCCEED) { - warn("ct_con_alloc failed"); - return 0; - } + if ((retcode = ct_con_alloc(context, &connection)) != CS_SUCCEED) { + warn("ct_con_alloc failed"); + return 0; + } - if (imp_dbh->locale) { - if (ct_con_props(connection, CS_SET, CS_LOC_PROP, - (CS_VOID*)imp_dbh->locale, CS_UNUSED, (CS_INT*)NULL) - != CS_SUCCEED) { + if (imp_dbh->locale) { + if (ct_con_props(connection, CS_SET, CS_LOC_PROP, + (CS_VOID*)imp_dbh->locale, CS_UNUSED, (CS_INT*)NULL) + != CS_SUCCEED) { - warn("ct_con_props(CS_LOC_PROP) failed"); - return 0; + warn("ct_con_props(CS_LOC_PROP) failed"); + return 0; + } } - } - if ((retcode = ct_con_props(connection, CS_SET, CS_USERDATA, &imp_dbh, - CS_SIZEOF(imp_dbh), NULL)) != CS_SUCCEED) { - warn("ct_con_props(CS_USERDATA) failed"); - return 0; - } - if (imp_dbh->tdsLevel[0] != 0) { - CS_INT value = 0; - if (strEQ(imp_dbh->tdsLevel, "CS_TDS_40")) + if ((retcode = ct_con_props(connection, CS_SET, CS_USERDATA, &imp_dbh, + CS_SIZEOF(imp_dbh), NULL)) != CS_SUCCEED) { + warn("ct_con_props(CS_USERDATA) failed"); + return 0; + } + if (imp_dbh->tdsLevel[0] != 0) { + CS_INT value = 0; + if (strEQ(imp_dbh->tdsLevel, "CS_TDS_40")) value = CS_TDS_40; - else if (strEQ(imp_dbh->tdsLevel, "CS_TDS_42")) + else if (strEQ(imp_dbh->tdsLevel, "CS_TDS_42")) value = CS_TDS_42; - else if (strEQ(imp_dbh->tdsLevel, "CS_TDS_46")) + else if (strEQ(imp_dbh->tdsLevel, "CS_TDS_46")) value = CS_TDS_46; - else if (strEQ(imp_dbh->tdsLevel, "CS_TDS_495")) + else if (strEQ(imp_dbh->tdsLevel, "CS_TDS_495")) value = CS_TDS_495; - else if (strEQ(imp_dbh->tdsLevel, "CS_TDS_50")) + else if (strEQ(imp_dbh->tdsLevel, "CS_TDS_50")) value = CS_TDS_50; - if (value) { - if (DBIc_DBISTATE(imp_dbh)->debug >= 3) + if (value) { + if (DBIc_DBISTATE(imp_dbh)->debug >= 3) PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_login() -> ct_con_props(CS_TDS_VERSION,%s)\n", imp_dbh->tdsLevel); - if (ct_con_props(connection, CS_SET, CS_TDS_VERSION, - (CS_VOID*)&value, CS_UNUSED, (CS_INT*)NULL) != CS_SUCCEED) { - warn("ct_con_props(CS_TDS_VERSION, %s) failed", - imp_dbh->tdsLevel); + if (ct_con_props(connection, CS_SET, CS_TDS_VERSION, + (CS_VOID*)&value, CS_UNUSED, (CS_INT*)NULL) != CS_SUCCEED) { + warn("ct_con_props(CS_TDS_VERSION, %s) failed", + imp_dbh->tdsLevel); + } + } else { + warn("Unkown tdsLevel value %s found", imp_dbh->tdsLevel); } - } else { - warn("Unkown tdsLevel value %s found", imp_dbh->tdsLevel); } - } - if (imp_dbh->packetSize[0] != 0) { - int i = atoi(imp_dbh->packetSize); - if (DBIc_DBISTATE(imp_dbh)->debug >= 3) + if (imp_dbh->packetSize[0] != 0) { + int i = atoi(imp_dbh->packetSize); + if (DBIc_DBISTATE(imp_dbh)->debug >= 3) PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_login() -> ct_con_props(CS_PACKETSIZE,%d)\n", i); - if (ct_con_props(connection, CS_SET, CS_PACKETSIZE, (CS_VOID*)&i, - CS_UNUSED, (CS_INT*)NULL) != CS_SUCCEED) { - warn("ct_con_props(CS_PACKETSIZE, %d) failed", i); - return 0; + if (ct_con_props(connection, CS_SET, CS_PACKETSIZE, (CS_VOID*)&i, + CS_UNUSED, (CS_INT*)NULL) != CS_SUCCEED) { + warn("ct_con_props(CS_PACKETSIZE, %d) failed", i); + return 0; + } } - } #if defined(CS_SEC_NETWORKAUTH) - if(imp_dbh->kerberosPrincipal[0] == 0) { + if(imp_dbh->kerberosPrincipal[0] == 0) { #endif - if (retcode == CS_SUCCEED && *imp_dbh->uid) { - if ((retcode = ct_con_props(connection, CS_SET, CS_USERNAME, - imp_dbh->uid, CS_NULLTERM, NULL)) != CS_SUCCEED) { - warn("ct_con_props(CS_USERNAME) failed"); - return 0; + if (retcode == CS_SUCCEED && *imp_dbh->uid) { + if ((retcode = ct_con_props(connection, CS_SET, CS_USERNAME, + imp_dbh->uid, CS_NULLTERM, NULL)) != CS_SUCCEED) { + warn("ct_con_props(CS_USERNAME) failed"); + return 0; + } } - } - if (retcode == CS_SUCCEED && *imp_dbh->pwd) { - if ((retcode = ct_con_props(connection, CS_SET, CS_PASSWORD, - imp_dbh->pwd, CS_NULLTERM, NULL)) != CS_SUCCEED) { - warn("ct_con_props(CS_PASSWORD) failed"); - return 0; + if (retcode == CS_SUCCEED && *imp_dbh->pwd) { + if ((retcode = ct_con_props(connection, CS_SET, CS_PASSWORD, + imp_dbh->pwd, CS_NULLTERM, NULL)) != CS_SUCCEED) { + warn("ct_con_props(CS_PASSWORD) failed"); + return 0; + } } - } #if defined(CS_SEC_NETWORKAUTH) - } else { - /* - ** If we're using Kerberos, set the appropriate connection properties - ** (which requires the Sybase Kerberos principal name). - */ - CS_INT i = CS_TRUE; - if(DBIc_DBISTATE(imp_dbh)->debug >= 3) + } else { + /* + ** If we're using Kerberos, set the appropriate connection properties + ** (which requires the Sybase Kerberos principal name). + */ + CS_INT i = CS_TRUE; + if(DBIc_DBISTATE(imp_dbh)->debug >= 3) PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_login() -> ct_con_props(CS_SERVERPRINCIPAL,%s)\n", imp_dbh->kerberosPrincipal); - /*warn( imp_dbh->kerberosPrincipal);*/ - if ((retcode = ct_con_props(connection, CS_SET, CS_SEC_NETWORKAUTH, - (CS_VOID *) &i, CS_UNUSED, NULL)) != CS_SUCCEED) - { - warn("ct_con_props(CS_SEC_NETWORKAUTH) failed"); - return 0; - } + /*warn( imp_dbh->kerberosPrincipal);*/ + if ((retcode = ct_con_props(connection, CS_SET, CS_SEC_NETWORKAUTH, + (CS_VOID *) &i, CS_UNUSED, NULL)) != CS_SUCCEED) + { + warn("ct_con_props(CS_SEC_NETWORKAUTH) failed"); + return 0; + } - if ((retcode = ct_con_props(connection, CS_SET, CS_SEC_SERVERPRINCIPAL, - imp_dbh->kerberosPrincipal, CS_NULLTERM, NULL)) != CS_SUCCEED) - { - warn("ct_con_props(CS_SEC_SERVERPRINCIPAL) failed"); - return 0; + if ((retcode = ct_con_props(connection, CS_SET, CS_SEC_SERVERPRINCIPAL, + imp_dbh->kerberosPrincipal, CS_NULLTERM, NULL)) != CS_SUCCEED) + { + warn("ct_con_props(CS_SEC_SERVERPRINCIPAL) failed"); + return 0; + } } - } #endif - if (retcode == CS_SUCCEED) { - if ((retcode = ct_con_props(connection, CS_SET, CS_APPNAME, - *imp_dbh->scriptName ? imp_dbh->scriptName : scriptName, - CS_NULLTERM, NULL)) != CS_SUCCEED) { - warn("ct_con_props(CS_APPNAME, %s) failed", imp_dbh->scriptName); - return 0; - } - if ((retcode = ct_con_props(connection, CS_SET, CS_HOSTNAME, - *imp_dbh->hostname ? imp_dbh->hostname : hostname, CS_NULLTERM, - NULL)) != CS_SUCCEED) { - warn("ct_con_props(CS_HOSTNAME, %s) failed", imp_dbh->hostname); - return 0; - } - } - if (retcode == CS_SUCCEED) { - if (imp_dbh->encryptPassword[0] != 0) { - int i = CS_TRUE; - if ((retcode = ct_con_props(connection, CS_SET, CS_SEC_ENCRYPTION, - (CS_VOID*)&i, CS_UNUSED, (CS_INT*)NULL)) != CS_SUCCEED) { - warn("ct_con_props(CS_SEC_ENCRYPTION, true) failed"); + if (retcode == CS_SUCCEED) { + if ((retcode = ct_con_props(connection, CS_SET, CS_APPNAME, + *imp_dbh->scriptName ? imp_dbh->scriptName : scriptName, + CS_NULLTERM, NULL)) != CS_SUCCEED) { + warn("ct_con_props(CS_APPNAME, %s) failed", imp_dbh->scriptName); + return 0; + } + if ((retcode = ct_con_props(connection, CS_SET, CS_HOSTNAME, + *imp_dbh->hostname ? imp_dbh->hostname : hostname, CS_NULLTERM, + NULL)) != CS_SUCCEED) { + warn("ct_con_props(CS_HOSTNAME, %s) failed", imp_dbh->hostname); return 0; } } - } + if (retcode == CS_SUCCEED) { + if (imp_dbh->encryptPassword[0] != 0) { + int i = CS_TRUE; + if ((retcode = ct_con_props(connection, CS_SET, CS_SEC_ENCRYPTION, + (CS_VOID*)&i, CS_UNUSED, (CS_INT*)NULL)) != CS_SUCCEED) { + warn("ct_con_props(CS_SEC_ENCRYPTION, true) failed"); + return 0; + } + } + } #if defined(CS_PROP_SSL_CA) - if(retcode == CS_SUCCEED) - { - if(imp_dbh->sslCAFile[0] != 0) { - if((retcode = ct_con_props(connection, CS_SET, CS_PROP_SSL_CA, - imp_dbh->sslCAFile, - CS_NULLTERM, (CS_INT*)NULL)) != CS_SUCCEED) - { - warn("ct_con_props(CS_PROP_SSL_CA, %s) failed", imp_dbh->sslCAFile); - return 0; + if(retcode == CS_SUCCEED) + { + if(imp_dbh->sslCAFile[0] != 0) { + if((retcode = ct_con_props(connection, CS_SET, CS_PROP_SSL_CA, + imp_dbh->sslCAFile, + CS_NULLTERM, (CS_INT*)NULL)) != CS_SUCCEED) + { + warn("ct_con_props(CS_PROP_SSL_CA, %s) failed", imp_dbh->sslCAFile); + return 0; + } } } - } #endif - if (retcode == CS_SUCCEED && imp_dbh->host[0] && imp_dbh->port[0]) { + if (retcode == CS_SUCCEED && imp_dbh->host[0] && imp_dbh->port[0]) { #if defined(CS_SERVERADDR) - char buff[255]; - sprintf(buff, "%.64s %.20s", imp_dbh->host, imp_dbh->port); - if((retcode = ct_con_props(connection, CS_SET, CS_SERVERADDR, - (CS_VOID*)buff, - CS_NULLTERM, (CS_INT*)NULL)) != CS_SUCCEED) - { - warn("ct_con_props(CS_SERVERADDR) failed"); - return 0; - } + char buff[255]; + sprintf(buff, "%.64s %.20s", imp_dbh->host, imp_dbh->port); + if((retcode = ct_con_props(connection, CS_SET, CS_SERVERADDR, + (CS_VOID*)buff, + CS_NULLTERM, (CS_INT*)NULL)) != CS_SUCCEED) + { + warn("ct_con_props(CS_SERVERADDR) failed"); + return 0; + } #else - croak("This version of OpenClient doesn't support CS_SERVERADDR"); + croak("This version of OpenClient doesn't support CS_SERVERADDR"); #endif - } + } - if (retcode == CS_SUCCEED && imp_dbh->blkLogin[0] != 0) { - CS_INT flag = CS_TRUE; - if ((retcode = ct_con_props(connection, CS_SET, CS_BULK_LOGIN, - (CS_VOID*)&flag, CS_UNUSED, (CS_INT*)NULL)) != CS_SUCCEED) { - warn("ct_con_props(CS_BULK_LOGIN) failed"); - return 0; + if (retcode == CS_SUCCEED && imp_dbh->blkLogin[0] != 0) { + CS_INT flag = CS_TRUE; + if ((retcode = ct_con_props(connection, CS_SET, CS_BULK_LOGIN, + (CS_VOID*)&flag, CS_UNUSED, (CS_INT*)NULL)) != CS_SUCCEED) { + warn("ct_con_props(CS_BULK_LOGIN) failed"); + return 0; + } } - } - if (retcode == CS_SUCCEED) { - len = *imp_dbh->server == 0 ? 0 : CS_NULLTERM; - if ((retcode = ct_connect(connection, imp_dbh->server, len)) - != CS_SUCCEED) { - if (locale != NULL) + if (retcode == CS_SUCCEED) { + len = *imp_dbh->server == 0 ? 0 : CS_NULLTERM; + if ((retcode = ct_connect(connection, imp_dbh->server, len)) + != CS_SUCCEED) { + if (locale != NULL) cs_loc_drop(context, locale); - ct_con_drop(connection); - return 0; + ct_con_drop(connection); + return 0; + } } - } - if (imp_dbh->ifile[0]) { - if ((retcode = ct_config(context, CS_SET, CS_IFILE, ofile, CS_NULLTERM, - NULL)) != CS_SUCCEED) + if (imp_dbh->ifile[0]) { + if ((retcode = ct_config(context, CS_SET, CS_IFILE, ofile, CS_NULLTERM, + NULL)) != CS_SUCCEED) warn("ct_config(CS_SET, CS_IFILE, %s) failed", ofile); - } + } - if (imp_dbh->database[0] || imp_dbh->curr_db[0]) { - int ret = syb_db_use(imp_dbh, connection); - if (imp_dbh->failedDbUseFatal && ret < 0) { - /* cleanup, and return NULL */ - ct_close(connection, CS_FORCE_CLOSE); - if (locale != NULL) + if (imp_dbh->database[0] || imp_dbh->curr_db[0]) { + int ret = syb_db_use(imp_dbh, connection); + if (imp_dbh->failedDbUseFatal && ret < 0) { + /* cleanup, and return NULL */ + ct_close(connection, CS_FORCE_CLOSE); + if (locale != NULL) cs_loc_drop(context, locale); - ct_con_drop(connection); + ct_con_drop(connection); - return 0; + return 0; + } } - } - if (imp_dbh->chainedSupported) { - CS_BOOL value = CS_FALSE; + if (imp_dbh->chainedSupported) { + CS_BOOL value = CS_FALSE; - /* Default to ct_option supported... */ - imp_dbh->optSupported = 1; + /* Default to ct_option supported... */ + imp_dbh->optSupported = 1; - if (DBIc_DBISTATE(imp_dbh)->debug >= 3) + if (DBIc_DBISTATE(imp_dbh)->debug >= 3) PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_login() -> checking for chained transactions\n"); - retcode = ct_options(connection, CS_SET, CS_OPT_CHAINXACTS, &value, - CS_UNUSED, NULL); - if (retcode == CS_FAIL) { - imp_dbh->doRealTran = 1; - imp_dbh->chainedSupported = 0; - } + retcode = ct_options(connection, CS_SET, CS_OPT_CHAINXACTS, &value, + CS_UNUSED, NULL); + if (retcode == CS_FAIL) { + imp_dbh->doRealTran = 1; + imp_dbh->chainedSupported = 0; + } #if 0 - /* This appears not to work - and hides the assignement to - optSupported done in the server callback */ + /* This appears not to work - and hides the assignement to + optSupported done in the server callback */ - /* No SRV_OPTION handler on the server... */ - if (imp_dbh->lasterr == 17001) + /* No SRV_OPTION handler on the server... */ + if (imp_dbh->lasterr == 17001) imp_dbh->optSupported = 0; - else + else imp_dbh->optSupported = 1; #endif - if (DBIc_DBISTATE(imp_dbh)->debug >= 3) + if (DBIc_DBISTATE(imp_dbh)->debug >= 3) PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_login() -> ct_option is %ssupported\n", imp_dbh->optSupported == 1 ?"":"not "); - if (DBIc_DBISTATE(imp_dbh)->debug >= 3) + if (DBIc_DBISTATE(imp_dbh)->debug >= 3) PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_login() -> chained transactions are %s supported\n", retcode == CS_FAIL ? "not" : ""); - } + } #if 0 - if(!imp_dbh->optSupported) { - imp_dbh->chainedSupported = 0; - imp_dbh->doRealTran = 1; /* XXX ??? */ - } + if(!imp_dbh->optSupported) { + imp_dbh->chainedSupported = 0; + imp_dbh->doRealTran = 1; /* XXX ??? */ + } #endif - if (imp_dbh->connection) { - /* we're setting a sub-connection, so make sure that any attributes - such as syb_quoted_identifier and syb_rowcount are set here too */ + if (imp_dbh->connection) { + /* we're setting a sub-connection, so make sure that any attributes + such as syb_quoted_identifier and syb_rowcount are set here too */ - if (imp_dbh->quotedIdentifier && imp_dbh->optSupported) { - CS_INT value = 1; - retcode = ct_options(connection, CS_SET, CS_OPT_QUOTED_IDENT, - &value, CS_UNUSED, NULL); - if (retcode != CS_SUCCEED) { - warn("Setting of CS_OPT_QUOTED_IDENT failed."); + if (imp_dbh->quotedIdentifier && imp_dbh->optSupported) { + CS_INT value = 1; + retcode = ct_options(connection, CS_SET, CS_OPT_QUOTED_IDENT, + &value, CS_UNUSED, NULL); + if (retcode != CS_SUCCEED) { + warn("Setting of CS_OPT_QUOTED_IDENT failed."); + } } - } #if defined(CS_OPT_ROWCOUNT) - if(imp_dbh->rowcount && imp_dbh->optSupported) { - CS_INT value = imp_dbh->rowcount; - retcode = ct_options(connection, CS_SET, CS_OPT_ROWCOUNT, - &value, CS_UNUSED, NULL); - if(retcode != CS_SUCCEED) { - warn("Setting of CS_OPT_ROWCOUNT failed."); + if(imp_dbh->rowcount && imp_dbh->optSupported) { + CS_INT value = imp_dbh->rowcount; + retcode = ct_options(connection, CS_SET, CS_OPT_ROWCOUNT, + &value, CS_UNUSED, NULL); + if(retcode != CS_SUCCEED) { + warn("Setting of CS_OPT_ROWCOUNT failed."); + } } - } #endif - } + } - return connection; -} + return connection; + } static int syb_db_use(imp_dbh_t *imp_dbh, CS_CONNECTION *connection) { CS_COMMAND *cmd = syb_alloc_cmd(imp_dbh, connection); @@ -1514,7 +1601,8 @@ sprintf(statement, "use %s", db); if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_use() -> ct_command(%s)\n", statement); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_use() -> ct_command(%s)\n", statement); ret = ct_command(cmd, CS_LANG_CMD, statement, CS_NULLTERM, CS_UNUSED); if (ret != CS_SUCCEED) { warn("ct_command failed for '%s'", statement); @@ -1527,8 +1615,8 @@ } while ((ret = ct_results(cmd, &restype)) == CS_SUCCEED) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_use() -> ct_results(%d)\n", - restype); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_use() -> ct_results(%d)\n", restype); if (restype == CS_CMD_FAIL) { warn("DBD::Sybase - can't change context to database %s\n", imp_dbh->database); @@ -1546,7 +1634,7 @@ if ((p = strchr(buff, '/'))) { ++p; if ((s = strchr(p, '/'))) { - strncpy(ver, p, s-p); + strncpy(ver, p, s - p); } else { strncpy(ver, p, 10); } @@ -1576,7 +1664,8 @@ sprintf(statement, "select @@version"); if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " get_server_version() -> ct_command(%s)\n", statement); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " get_server_version() -> ct_command(%s)\n", statement); ret = ct_command(cmd, CS_LANG_CMD, statement, CS_NULLTERM, CS_UNUSED); if (ret != CS_SUCCEED) { warn("ct_command failed for '%s'", statement); @@ -1589,11 +1678,12 @@ } while ((ret = ct_results(cmd, &restype)) == CS_SUCCEED) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " get_server_version() -> ct_results(%d)\n", - restype); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " get_server_version() -> ct_results(%d)\n", restype); if (restype == CS_CMD_FAIL) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " get_server_version() -> Can't get version value\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " get_server_version() -> Can't get version value\n"); retval = -1; } if (restype == CS_ROW_RESULT) { @@ -1610,14 +1700,17 @@ while ((retcode = ct_fetch(cmd, CS_UNUSED, CS_UNUSED, CS_UNUSED, &rows)) == CS_SUCCEED) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " get_server_version() -> version = %s\n", buff); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " get_server_version() -> version = %s\n", buff); strncpy(imp_dbh->serverVersionString, buff, sizeof(imp_dbh->serverVersionString)); extract_version(buff, version); strncpy(imp_dbh->serverVersion, version, sizeof(imp_dbh->serverVersion)); if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " get_server_version() -> version = %s\n", imp_dbh->serverVersion); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " get_server_version() -> version = %s\n", + imp_dbh->serverVersion); } } @@ -1637,8 +1730,7 @@ if (DBIc_ACTIVE_KIDS(imp_dbh)) { DBIh_SET_ERR_CHAR(dbh, (imp_xxh_t *)imp_dbh, NULL, -1, "Can't call ping() with active statement handles", - NULL, NULL) - ; + NULL, NULL); return -1; } @@ -1650,7 +1742,8 @@ return 0; if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_ping() -> ct_command(%s)\n", statement); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_ping() -> ct_command(%s)\n", statement); ret = ct_command(cmd, CS_LANG_CMD, statement, CS_NULLTERM, CS_UNUSED); if (ret != CS_SUCCEED) { ct_cmd_drop(cmd); @@ -1663,8 +1756,8 @@ } while ((ret = ct_results(cmd, &restype)) == CS_SUCCEED) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_ping() -> ct_results(%d)\n", - restype); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_ping() -> ct_results(%d)\n", restype); if (imp_dbh->isDead) { ct_cmd_drop(cmd); return 0; @@ -1709,19 +1802,25 @@ type = CS_DATES_YMD3_YYYY; } else if (!strcmp(fmt, "HMS")) { type = CS_DATES_HMS; + } else if (!strcmp(fmt, "LONGMS")) { +#if defined(CS_DATES_LONGUSA_YYYY) + type = CS_DATES_LONGUSA_YYYY; +#else + type = CS_DATES_LONG; +#endif } else { warn("Invalid format %s in _date_fmt", fmt); return 0; } - if (cs_dt_info(context, CS_SET, LOCALE(imp_dbh), CS_DT_CONVFMT, CS_UNUSED, (CS_VOID*)&type, - CS_SIZEOF(CS_INT), NULL) != CS_SUCCEED) { - warn("cs_dt_info() failed"); + if (cs_dt_info(context, CS_SET, LOCALE(imp_dbh), CS_DT_CONVFMT, CS_UNUSED, + (CS_VOID*) &type, CS_SIZEOF(CS_INT), NULL) != CS_SUCCEED) { + warn("cs_dt_info() failed"); - return 0; - } + return 0; + } - return 1; -} + return 1; + } static int syb_get_date_fmt(imp_dbh_t *imp_dbh, char *fmt) { CS_INT type; @@ -1736,45 +1835,45 @@ return 1; } - if (cs_dt_info(context, CS_GET, LOCALE(imp_dbh), CS_DT_CONVFMT, CS_UNUSED, (CS_VOID*)&type, - CS_SIZEOF(CS_INT), NULL) != CS_SUCCEED) { - warn("cs_dt_info() failed"); + if (cs_dt_info(context, CS_GET, LOCALE(imp_dbh), CS_DT_CONVFMT, CS_UNUSED, + (CS_VOID*) &type, CS_SIZEOF(CS_INT), NULL) != CS_SUCCEED) { + warn("cs_dt_info() failed"); - return 0; - } - switch (type) { - case CS_DATES_LONG: - p = "LONG"; - break; - case CS_DATES_SHORT: - p = "SHORT"; - break; - case CS_DATES_DMY4_YYYY: - p = "DMY4_YYYY"; - break; - case CS_DATES_MDY1_YYYY: - p = "MDY1_YYYY"; - break; - case CS_DATES_DMY1_YYYY: - p = "DMY1_YYYY"; - break; - case CS_DATES_DMY2_YYYY: - p = "DMY2_YYYY"; - break; - case CS_DATES_YMD3_YYYY: - p = "YMD3_YYYY"; - break; - case CS_DATES_HMS: - p = "HMS"; - break; - default: - p = "Unknown"; - break; - } - strcpy(fmt, p); + return 0; + } + switch (type) { + case CS_DATES_LONG: + p = "LONG"; + break; + case CS_DATES_SHORT: + p = "SHORT"; + break; + case CS_DATES_DMY4_YYYY: + p = "DMY4_YYYY"; + break; + case CS_DATES_MDY1_YYYY: + p = "MDY1_YYYY"; + break; + case CS_DATES_DMY1_YYYY: + p = "DMY1_YYYY"; + break; + case CS_DATES_DMY2_YYYY: + p = "DMY2_YYYY"; + break; + case CS_DATES_YMD3_YYYY: + p = "YMD3_YYYY"; + break; + case CS_DATES_HMS: + p = "HMS"; + break; + default: + p = "Unknown"; + break; + } + strcpy(fmt, p); - return 1; -} + return 1; + } int syb_discon_all(SV *drh, imp_drh_t *imp_drh) { /* disconnect_all is not implemented */ @@ -1798,7 +1897,9 @@ } ret = blk_done(imp_sth->bcp_desc, type, &imp_sth->numRows); if (DBIc_DBISTATE(imp_sth)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_sth), " syb_blk_done -> blk_done(%d, %d, %d) = %d\n", imp_sth->bcp_desc, type, imp_sth->numRows, ret); + PerlIO_printf(DBIc_LOGPIO(imp_sth), + " syb_blk_done -> blk_done(%d, %d, %d) = %d\n", + imp_sth->bcp_desc, type, imp_sth->numRows, ret); /* reset row counter if blk_done was successful */ if (ret == CS_SUCCEED) { @@ -1809,7 +1910,9 @@ } if (DBIc_DBISTATE(imp_sth)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_sth), " syb_blk_done(%d) -> ret = %d, rows = %d\n", type, ret, imp_sth->numRows); + PerlIO_printf(DBIc_LOGPIO(imp_sth), + " syb_blk_done(%d) -> ret = %d, rows = %d\n", type, ret, + imp_sth->numRows); return ret == CS_SUCCEED; } @@ -1824,7 +1927,8 @@ if (imp_dbh->imp_sth && imp_dbh->imp_sth->bcpFlag) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_commit() -> bcp op, calling syb_blk_done()\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_commit() -> bcp op, calling syb_blk_done()\n"); return syb_blk_done(imp_dbh->imp_sth, CS_BLK_BATCH); } @@ -1842,7 +1946,8 @@ else strcpy(buff, "\nCOMMIT TRAN\n"); if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_commit() -> ct_command(%s)\n", buff); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_commit() -> ct_command(%s)\n", buff); retcode = ct_command(cmd, CS_LANG_CMD, buff, CS_NULLTERM, CS_UNUSED); if (retcode != CS_SUCCEED) return 0; @@ -1851,12 +1956,14 @@ return 0; if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_commit() -> ct_send() OK\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_commit() -> ct_send() OK\n"); while ((retcode = ct_results(cmd, &restype)) == CS_SUCCEED) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_commit() -> ct_results(%d) == %d\n", - restype, retcode); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_commit() -> ct_results(%d) == %d\n", restype, + retcode); if (restype == CS_CMD_FAIL) failFlag = 1; @@ -1877,7 +1984,8 @@ if (imp_dbh->imp_sth && imp_dbh->imp_sth->bcpFlag) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_rollback() -> bcp op, calling syb_blk_done()\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_rollback() -> bcp op, calling syb_blk_done()\n"); return syb_blk_done(imp_dbh->imp_sth, CS_BLK_CANCEL); } @@ -1895,7 +2003,8 @@ else strcpy(buff, "\nROLLBACK TRAN\n"); if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_rollback() -> ct_command(%s)\n", buff); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_rollback() -> ct_command(%s)\n", buff); retcode = ct_command(cmd, CS_LANG_CMD, buff, CS_NULLTERM, CS_UNUSED); if (retcode != CS_SUCCEED) return 0; @@ -1904,12 +2013,14 @@ return 0; if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_rollback() -> ct_send() OK\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_rollback() -> ct_send() OK\n"); while ((retcode = ct_results(cmd, &restype)) == CS_SUCCEED) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_rollback() -> ct_results(%d) == %d\n", - restype, retcode); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_rollback() -> ct_results(%d) == %d\n", restype, + retcode); if (restype == CS_CMD_FAIL) failFlag = 1; @@ -1935,22 +2046,23 @@ sprintf(buff, "\nBEGIN TRAN %s\n", imp_dbh->tranName); retcode = ct_command(cmd, CS_LANG_CMD, buff, CS_NULLTERM, CS_UNUSED); if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_opentran() -> ct_command(%s) = %d\n", - buff, retcode); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_opentran() -> ct_command(%s) = %d\n", buff, retcode); if (retcode != CS_SUCCEED) return 0; retcode = ct_send(cmd); if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_opentran() -> ct_send() = %d\n", - retcode); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_opentran() -> ct_send() = %d\n", retcode); if (retcode != CS_SUCCEED) return 0; while ((retcode = ct_results(cmd, &restype)) == CS_SUCCEED) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_opentran() -> ct_results(%d) == %d\n", - restype, retcode); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_opentran() -> ct_results(%d) == %d\n", restype, + retcode); if (restype == CS_CMD_FAIL) failFlag = 1; @@ -1969,13 +2081,15 @@ /* If we are called in a process that is different from the one where the handle * was created then we do NOT disconnect. */ - if(imp_dbh->disconnectInChild = 0 && imp_dbh->pid != getpid()) { + if (imp_dbh->disconnectInChild = 0 && imp_dbh->pid != getpid()) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_disconnect() -> imp_dbh->pid (%d) != pid (%d) - not closing connection\n", - imp_dbh->pid, getpid()); + PerlIO_printf( + DBIc_LOGPIO(imp_dbh), + " syb_db_disconnect() -> imp_dbh->pid (%d) != pid (%d) - not closing connection\n", + imp_dbh->pid, getpid()); return 0; } - + /* rollback if we get disconnected and no explicit commit has been called (when in non-AutoCommit mode) */ if (imp_dbh->isDead == 0) { /* only call if connection still active */ @@ -1984,15 +2098,19 @@ } if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_disconnect() -> ct_close()\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_disconnect() -> ct_close()\n"); if ((retcode = ct_close(imp_dbh->connection, CS_FORCE_CLOSE)) != CS_SUCCEED) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_disconnect(): ct_close() failed\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_disconnect(): ct_close() failed\n"); if (imp_dbh->locale && (retcode = cs_loc_drop(context, imp_dbh->locale)) != CS_SUCCEED) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_disconnect(): cs_loc_drop() failed\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_disconnect(): cs_loc_drop() failed\n"); if ((retcode = ct_con_drop(imp_dbh->connection)) != CS_SUCCEED) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_disconnect(): ct_con_drop() failed\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_disconnect(): ct_con_drop() failed\n"); DBIc_ACTIVE_off(imp_dbh); @@ -2030,14 +2148,18 @@ imp_dbh->doRealTran = 1; } if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_STORE() -> syb_chained_txn => %d\n", on); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_STORE() -> syb_chained_txn => %d\n", on); if (!autocommit && imp_dbh->optSupported) { CS_BOOL value = on ? CS_TRUE : CS_FALSE; CS_RETCODE ret; ret = syb_set_options(imp_dbh, CS_SET, CS_OPT_CHAINXACTS, &value, CS_UNUSED, NULL); if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_STORE() -> syb_chained_txn AutoCommit off CS_OPT_CHAINXACTS(%d) => %d\n", value, ret); + PerlIO_printf( + DBIc_LOGPIO(imp_dbh), + " syb_db_STORE() -> syb_chained_txn AutoCommit off CS_OPT_CHAINXACTS(%d) => %d\n", + value, ret); } } else { @@ -2055,13 +2177,15 @@ */ if (imp_dbh->imp_sth && imp_dbh->imp_sth->bcpFlag) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_STORE(): AutoCommit value changes inhibitted during BCP ops\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_db_STORE(): AutoCommit value changes inhibitted during BCP ops\n"); return TRUE; } on = SvTRUE(valuesv); if (DBIc_ACTIVE_KIDS(imp_dbh) && ((on && !crnt) || (!on && crnt))) { - croak("panic: can't change AutoCommit (from %d to %d) with active statement handles", + croak( + "panic: can't change AutoCommit (from %d to %d) with active statement handles", on, crnt); } @@ -2098,7 +2222,8 @@ CS_RETCODE ret; if (imp_dbh->inUse) { - warn("Can't set syb_quoted_identifier because the database handle is in use."); + warn( + "Can't set syb_quoted_identifier because the database handle is in use."); return FALSE; } @@ -2132,19 +2257,33 @@ return TRUE; } if (kl == 15 && strEQ(key, "syb_err_handler")) { - if (valuesv == &PL_sv_undef) { + if (!SvOK(valuesv)) { imp_dbh->err_handler = NULL; - } else if (imp_dbh->err_handler == (SV*)NULL) { + } else if (imp_dbh->err_handler == (SV*) NULL) { imp_dbh->err_handler = newSVsv(valuesv); } else { sv_setsv(imp_dbh->err_handler, valuesv); } return TRUE; } + if (kl == 15 && strEQ(key, "syb_enable_utf8")) { +#if !defined(DBD_CAN_HANDLE_UTF8) + warn("The current version of OpenClient can't handle utf8 data."); + return FALSE; +#else + on = SvTRUE(valuesv); + if (on) { + imp_dbh->enable_utf8 = 1; + } else { + imp_dbh->enable_utf8 = 0; + } + return TRUE; +#endif + } if (kl == 16 && strEQ(key, "syb_row_callback")) { - if (valuesv == &PL_sv_undef) { + if (!SvOK(valuesv)) { imp_dbh->row_cb = NULL; - } else if (imp_dbh->row_cb == (SV*)NULL) { + } else if (imp_dbh->row_cb == (SV*) NULL) { imp_dbh->row_cb = newSVsv(valuesv); } else { sv_setsv(imp_dbh->row_cb, valuesv); @@ -2165,14 +2304,15 @@ CS_INT value = SvIV(valuesv); CS_RETCODE ret; - if(imp_dbh->inUse) { - warn("Can't set syb_rowcount because the database handle is in use."); + if (imp_dbh->inUse) { + warn( + "Can't set syb_rowcount because the database handle is in use."); return FALSE; } - ret = syb_set_options(imp_dbh, CS_SET, CS_OPT_ROWCOUNT, - &value, CS_UNUSED, NULL); - if(ret != CS_SUCCEED) { + ret = syb_set_options(imp_dbh, CS_SET, CS_OPT_ROWCOUNT, &value, + CS_UNUSED, NULL); + if (ret != CS_SUCCEED) { warn("Setting of CS_OPT_ROWCOUNT failed."); return FALSE; } @@ -2262,18 +2402,18 @@ } if (kl == 23 && strEQ(key, "syb_disconnect_in_child")) { imp_dbh->disconnectInChild = SvIV(valuesv); - + return TRUE; } if (kl == 18 && strEQ(key, "syb_server_version")) { - strncpy(imp_dbh->serverVersion, SvPV(valuesv, na), 15); + strncpy(imp_dbh->serverVersion, SvPV(valuesv, PL_na), 15); return TRUE; } if (kl == 12 && strEQ(key, "syb_date_fmt")) { - syb_db_date_fmt(dbh, imp_dbh, SvPV(valuesv, na)); + syb_db_date_fmt(dbh, imp_dbh, SvPV(valuesv, PL_na)); return TRUE; } @@ -2327,6 +2467,13 @@ retsv = &PL_sv_undef; } } + if (kl == 15 && strEQ(key, "syb_enable_utf8")) { + if (imp_dbh->enable_utf8) { + retsv = newSViv(1); + } else { + retsv = newSViv(0); + } + } if (kl == 16 && strEQ(key, "syb_row_callback")) { if (imp_dbh->row_cb) { retsv = newSVsv(imp_dbh->row_cb); @@ -2359,7 +2506,7 @@ if (kl == 21 && strEQ(key, "syb_dynamic_supported")) { CS_BOOL val; CS_RETCODE ret = ct_capability(imp_dbh->connection, CS_GET, - CS_CAP_REQUEST, CS_REQ_DYN, (CS_VOID*)&val); + CS_CAP_REQUEST, CS_REQ_DYN, (CS_VOID*) &val); if (ret != CS_SUCCEED || val == CS_FALSE) retsv = newSViv(0); else @@ -2436,13 +2583,13 @@ } if (kl == 11 && strEQ(key, "syb_has_blk")) { #if defined(NO_BLK) - retsv = &sv_no; + retsv = &PL_sv_no; #else - retsv = &sv_yes; + retsv = &PL_sv_yes; #endif } - if (retsv == &sv_yes || retsv == &sv_no || retsv == &PL_sv_undef) + if (retsv == &PL_sv_yes || retsv == &PL_sv_no || retsv == &PL_sv_undef) return retsv; return sv_2mortal(retsv); @@ -2457,28 +2604,32 @@ return NULL; } if (DBIc_DBISTATE(imp_dbh)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_alloc_cmd() -> CS_COMMAND %x for CS_CONNECTION %x\n", cmd, connection); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_alloc_cmd() -> CS_COMMAND %x for CS_CONNECTION %x\n", + cmd, connection); return cmd; } static void dbd_preparse(imp_sth_t *imp_sth, char *statement) { dTHX; - enum {DEFAULT, LITERAL, COMMENT, LINE_COMMENT, VARIABLE} STATES; + enum { + DEFAULT, LITERAL, COMMENT, LINE_COMMENT, VARIABLE + } STATES; int state = DEFAULT; int next_state; char last_literal = 0; char *src, *start, *dest; phs_t phs_tpl; SV *phs_sv; - int idx=0; + int idx = 0; STRLEN namelen; #define VARNAME_LEN 255 char varname[VARNAME_LEN + 1]; int pos; /* allocate room for copy of statement with spare capacity */ - imp_sth->statement = (char*)safemalloc(strlen(statement) * 3); + imp_sth->statement = (char*) safemalloc(strlen(statement) * 3); /* initialise phs ready to be cloned per placeholder */ memset(&phs_tpl, 0, sizeof(phs_tpl)); @@ -2509,9 +2660,9 @@ if (*src == '\'' || *src == '"') { last_literal = *src; next_state = LITERAL; - } else if (*src == '/' && *(src+1) == '*') { + } else if (*src == '/' && *(src + 1) == '*') { next_state = COMMENT; - } else if (*src == '-' && *(src+1) == '-') { + } else if (*src == '-' && *(src + 1) == '-') { next_state = LINE_COMMENT; } else if (*src == '@') { varname[0] = '@'; @@ -2525,7 +2676,7 @@ } break; case COMMENT: - if (*(src-1) == '*' && *src == '/') { + if (*(src - 1) == '*' && *src == '/') { next_state = DEFAULT; } break; @@ -2554,19 +2705,19 @@ *dest++ = *src++; if (*start == '?') { /* X/Open standard */ sprintf(start, ":p%d", ++idx); /* '?' -> ':p1' (etc) */ - dest = start+strlen(start); + dest = start + strlen(start); } else { /* not a placeholder, so just copy */ continue; } *dest = '\0'; /* handy for debugging */ - namelen = (dest-start); + namelen = (dest - start); if (imp_sth->all_params_hv == NULL) imp_sth->all_params_hv = newHV(); phs_tpl.sv = &PL_sv_undef; - phs_sv = newSVpv((char*)&phs_tpl, sizeof(phs_tpl)+namelen+1); + phs_sv = newSVpv((char*) &phs_tpl, sizeof(phs_tpl) + namelen + 1); hv_store(imp_sth->all_params_hv, start, namelen, phs_sv, 0); - strcpy(((phs_t*)(void*)SvPVX(phs_sv))->name, start); - strcpy(((phs_t*)(void*)SvPVX(phs_sv))->varname, varname); + strcpy(((phs_t*) (void*) SvPVX(phs_sv))->name, start); + strcpy(((phs_t*) (void*) SvPVX(phs_sv))->varname, varname); if (imp_sth->type == 1) { /* if it's an EXEC call, check for OUTPUT */ char *p = src; do { @@ -2576,7 +2727,7 @@ continue; if (isalpha(*p)) { if (!strncasecmp(p, "out", 3)) { - ((phs_t*)(void*)SvPVX(phs_sv))->is_inout = 1; + ((phs_t*) (void*) SvPVX(phs_sv))->is_inout = 1; } else { break; } @@ -2584,17 +2735,19 @@ } while (*(++p)); } if (DBIc_DBISTATE(imp_sth)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_sth), " dbd_preparse parameter %s (%s)\n", - ((phs_t*)(void*)SvPVX(phs_sv))->name, - ((phs_t*)(void*)SvPVX(phs_sv))->varname); + PerlIO_printf(DBIc_LOGPIO(imp_sth), + " dbd_preparse parameter %s (%s)\n", + ((phs_t*) (void*) SvPVX(phs_sv))->name, + ((phs_t*) (void*) SvPVX(phs_sv))->varname); /* warn("params_hv: '%s'\n", start); */ } *dest = '\0'; if (imp_sth->all_params_hv) { - DBIc_NUM_PARAMS(imp_sth) = (int)HvKEYS(imp_sth->all_params_hv); + DBIc_NUM_PARAMS(imp_sth) = (int) HvKEYS(imp_sth->all_params_hv); if (DBIc_DBISTATE(imp_sth)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_sth), " dbd_preparse scanned %d distinct placeholders\n", - (int)DBIc_NUM_PARAMS(imp_sth)); + PerlIO_printf(DBIc_LOGPIO(imp_sth), + " dbd_preparse scanned %d distinct placeholders\n", + (int) DBIc_NUM_PARAMS(imp_sth)); } } @@ -2608,11 +2761,12 @@ CS_RETCODE ret; ret = ct_capability(imp_dbh->connection, CS_GET, CS_CAP_REQUEST, - CS_REQ_DYN, (CS_VOID*)&val); + CS_REQ_DYN, (CS_VOID*) &val); if (ret != CS_SUCCEED || val == CS_FALSE) - croak("Panic: dynamic SQL (? placeholders) are not supported by the server you are connecting to"); + croak( + "Panic: dynamic SQL (? placeholders) are not supported by the server you are connecting to"); - sprintf(imp_sth->dyn_id, "DBD%d", (int)tt++); + sprintf(imp_sth->dyn_id, "DBD%d", (int) tt++); if (DBIc_DBISTATE(imp_dbh)->debug >= 3) PerlIO_printf(DBIc_LOGPIO(imp_dbh), @@ -2656,7 +2810,8 @@ imp_sth->dyn_id); while ((ret = ct_results(imp_sth->cmd, &restype)) == CS_SUCCEED) { if (DBIc_DBISTATE(imp_dbh)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), + PerlIO_printf( + DBIc_LOGPIO(imp_dbh), " dyn_prepare: ct_results(CS_DESCRIBE_INPUT) for %s - restype %d\n", imp_sth->dyn_id, restype); if (restype == CS_DESCRIBE_RESULT) { @@ -2672,14 +2827,19 @@ if (ret != CS_SUCCEED) warn("ct_res_info(CS_DESCRIBE_INPUT) returned %d", ret); if (DBIc_DBISTATE(imp_dbh)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " dyn_prepare: ct_res_info(CS_DESCRIBE_INPUT) statement has %d parameters\n", num_param); + PerlIO_printf( + DBIc_LOGPIO(imp_dbh), + " dyn_prepare: ct_res_info(CS_DESCRIBE_INPUT) statement has %d parameters\n", + num_param); for (i = 1; i <= num_param; ++i) { sprintf(name, ":p%d", i); svp = hv_fetch(imp_sth->all_params_hv, name, strlen(name), 0); - phs = ((phs_t*)(void*)SvPVX(*svp)); + phs = ((phs_t*) (void*) SvPVX(*svp)); ct_describe(imp_sth->cmd, i, &phs->datafmt); if (DBIc_DBISTATE(imp_dbh)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " dyn_prepare: ct_describe(CS_DESCRIBE_INPUT) col %d, type %d, name %s, status %d, length %d\n", + PerlIO_printf( + DBIc_LOGPIO(imp_dbh), + " dyn_prepare: ct_describe(CS_DESCRIBE_INPUT) col %d, type %d, name %s, status %d, length %d\n", i, phs->datafmt.datatype, phs->datafmt.name, phs->datafmt.status, phs->datafmt.maxlength); } @@ -2716,8 +2876,7 @@ if (DBIc_DBISTATE(imp_dbh)->debug >= 3) PerlIO_printf(DBIc_LOGPIO(imp_dbh), - " syb_st_prepare() -> inUse = %d\n", - imp_dbh->inUse); + " syb_st_prepare() -> inUse = %d\n", imp_dbh->inUse); if (DBIc_ACTIVE_KIDS(DBIc_PARENT_COM(imp_sth)) || imp_dbh->inUse) { int retval = 1; @@ -2728,9 +2887,11 @@ return 0; } if (!DBIc_is(imp_dbh, DBIcf_AutoCommit)) - croak("Panic: Can't have multiple statement handles on a single database handle when AutoCommit is OFF"); + croak( + "Panic: Can't have multiple statement handles on a single database handle when AutoCommit is OFF"); if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_st_prepare() parent has active kids - opening new connection\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_st_prepare() parent has active kids - opening new connection\n"); #if PERL_VERSION >= 8 && defined(_REENTRANT) MUTEX_LOCK(context_alloc_mutex); @@ -2747,7 +2908,7 @@ } if (imp_sth->statement != NULL) - safefree(imp_sth->statement); + Safefree(imp_sth->statement); imp_sth->statement = NULL; dbd_preparse(imp_sth, statement); imp_dbh->sql = imp_sth->statement; @@ -2756,7 +2917,7 @@ if (syb_db_opentran(NULL, imp_dbh) == 0) return -2; - if ((int)DBIc_NUM_PARAMS(imp_sth)) { + if ((int) DBIc_NUM_PARAMS(imp_sth)) { /* regular dynamic sql */ if (imp_sth->type == 0) { ret = dyn_prepare(imp_dbh, imp_sth, statement); @@ -2771,8 +2932,8 @@ croak("DBD::Sybase: describe_proc failed!\n"); } if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " describe_proc: procname = %s\n", - imp_sth->proc); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " describe_proc: procname = %s\n", imp_sth->proc); imp_sth->cmd = syb_alloc_cmd(imp_dbh, imp_sth->connection ? imp_sth->connection @@ -2832,17 +2993,18 @@ tok = strtok(buff, " \n\t"); if (strncasecmp(tok, "exec", 4)) { - safefree(buff); + Safefree(buff); return 0; /* it's gotta start with exec(ute) */ } tok = strtok(NULL, " \n\t"); /* this is the proc name */ if (!tok || !*tok) { - warn("DBD::Sybase: describe_proc: didn't get a proc name in EXEC statement\n"); - safefree(buff); + warn( + "DBD::Sybase: describe_proc: didn't get a proc name in EXEC statement\n"); + Safefree(buff); return 0; } strcpy(imp_sth->proc, tok); - safefree(buff); + Safefree(buff); return 1; } @@ -2855,6 +3017,7 @@ int numCols = DBIc_NUM_FIELDS(imp_sth); for (i = 0; i < numCols; ++i) { if (imp_sth->coldata[i].type == CS_CHAR_TYPE + || imp_sth->coldata[i].type == CS_LONGCHAR_TYPE || imp_sth->coldata[i].type == CS_TEXT_TYPE || imp_sth->coldata[i].type == CS_IMAGE_TYPE) { Safefree(imp_sth->coldata[i].value.c); @@ -2891,7 +3054,8 @@ goto GoodBye; } if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " ct_res_info() returns %d columns\n", numCols); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " ct_res_info() returns %d columns\n", numCols); /* According to Tim Bunce I shouldn't need the code below. However, if I remove it DBD::Sybase segfaults in some situations @@ -2899,13 +3063,12 @@ statements with DBI >= 1.54. */ /* Adjust NUM_OF_FIELDS - which also adjusts the row buffer size */ DBIc_NUM_FIELDS(imp_sth) = 0; /* for DBI <= 1.53 */ - DBIc_DBISTATE(imp_sth)->set_attr_k(sth, - sv_2mortal(newSVpvn("NUM_OF_FIELDS", 13)), 0, - sv_2mortal(newSViv(numCols)) ); + DBIc_DBISTATE(imp_sth)->set_attr_k(sth, sv_2mortal( + newSVpvn("NUM_OF_FIELDS", 13)), 0, sv_2mortal(newSViv(numCols))); #if 1 /* for DBI <= 1.53 (and 1.54 which doesn't shrink properly) */ av = DBIc_FIELDS_AV(imp_sth); - if (av && av_len(av)+1 != numCols) { + if (av && av_len(av) + 1 != numCols) { SvREADONLY_off(av); /* DBI sets this readonly */ av_clear(av); i = numCols; @@ -2941,7 +3104,7 @@ } /* Make sure we have at least some sort of column name: */ if (imp_sth->datafmt[i].namelen == 0) - sprintf(imp_sth->datafmt[i].name, "COL(%d)", i+1); + sprintf(imp_sth->datafmt[i].name, "COL(%d)", i + 1); if (restype == CS_COMPUTE_RESULT) { CS_INT agg_op, outlen; CS_CHAR *agg_op_name; @@ -2961,9 +3124,9 @@ } if (DBIc_DBISTATE(imp_dbh)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " ct_describe(%d): type = %d, maxlen = %d\n", - i, imp_sth->datafmt[i].datatype, - imp_sth->datafmt[i].maxlength); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " ct_describe(%d): type = %d, maxlen = %d\n", i, + imp_sth->datafmt[i].datatype, imp_sth->datafmt[i].maxlength); imp_sth->coldata[i].realType = imp_sth->datafmt[i].datatype; imp_sth->coldata[i].realLength = imp_sth->datafmt[i].maxlength; @@ -2985,9 +3148,9 @@ &imp_sth->coldata[i].indicator); break; -#if 1 && defined(CS_UINT_TYPE) - case CS_USMALLINT_TYPE: - case CS_UINT_TYPE: +#if defined(SYB_NATIVE_NUM) && defined(CS_UINT_TYPE) + case CS_USMALLINT_TYPE: + case CS_UINT_TYPE: imp_sth->datafmt[i].maxlength = sizeof(CS_INT); imp_sth->datafmt[i].format = CS_FMT_UNUSED; imp_sth->coldata[i].type = CS_UINT_TYPE; @@ -2998,9 +3161,9 @@ &imp_sth->coldata[i].indicator); break; #endif -#if 1 +#if defined(SYB_NATIVE_NUM) #if defined(CS_BIGINT_TYPE) - case CS_BIGINT_TYPE: + case CS_BIGINT_TYPE: imp_sth->datafmt[i].maxlength = sizeof(CS_BIGINT); imp_sth->datafmt[i].format = CS_FMT_UNUSED; imp_sth->coldata[i].type = CS_BIGINT_TYPE; @@ -3012,7 +3175,7 @@ break; #endif #if defined(CS_UBIGINT_TYPE) - case CS_UBIGINT_TYPE: + case CS_UBIGINT_TYPE: imp_sth->datafmt[i].maxlength = sizeof(CS_UBIGINT); imp_sth->datafmt[i].format = CS_FMT_UNUSED; imp_sth->coldata[i].type = CS_UBIGINT_TYPE; @@ -3025,8 +3188,10 @@ #endif #endif - case CS_MONEY_TYPE: - case CS_MONEY4_TYPE: +#if defined(SYB_NATIVE_NUM) + case CS_MONEY_TYPE: + case CS_MONEY4_TYPE: +#endif case CS_REAL_TYPE: case CS_FLOAT_TYPE: imp_sth->datafmt[i].maxlength = sizeof(CS_FLOAT); @@ -3041,6 +3206,9 @@ case CS_TEXT_TYPE: case CS_IMAGE_TYPE: +#if defined(CS_UNITEXT_TYPE) + case CS_UNITEXT_TYPE: +#endif New(902, imp_sth->coldata[i].value.c, imp_sth->datafmt[i].maxlength, char); imp_sth->datafmt[i].format = CS_FMT_UNUSED; /*CS_FMT_NULLTERM;*/ @@ -3093,6 +3261,7 @@ #endif case CS_CHAR_TYPE: + case CS_LONGCHAR_TYPE: case CS_VARCHAR_TYPE: case CS_BINARY_TYPE: case CS_VARBINARY_TYPE: @@ -3100,7 +3269,7 @@ case CS_DECIMAL_TYPE: default: imp_sth->datafmt[i].maxlength = get_cwidth(&imp_sth->datafmt[i]) - + 1; + + 1; /*display_dlen(&imp_sth->datafmt[i]) + 1;*/ imp_sth->datafmt[i].format = CS_FMT_UNUSED; New(902, imp_sth->coldata[i].value.c, @@ -3115,7 +3284,7 @@ if (imp_sth->coldata[i].realType == CS_BINARY_TYPE || imp_sth->coldata[i].realType == CS_VARBINARY_TYPE) { imp_sth->coldata[i].type = imp_sth->datafmt[i].datatype - = imp_sth->coldata[i].realType; + = imp_sth->coldata[i].realType; } break; } @@ -3127,7 +3296,9 @@ break; } if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " describe() -> col %d, type %d, realtype %d\n", i, imp_sth->coldata[i].type, imp_sth->coldata[i].realType); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " describe() -> col %d, type %d, realtype %d\n", i, + imp_sth->coldata[i].type, imp_sth->coldata[i].realType); } GoodBye: ; @@ -3141,7 +3312,9 @@ D_imp_dbh_from_sth; if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " clear_sth_flags() -> resetting ACTIVE, moreResults, dyn_execed, exec_done\n"); + PerlIO_printf( + DBIc_LOGPIO(imp_dbh), + " clear_sth_flags() -> resetting ACTIVE, moreResults, dyn_execed, exec_done\n"); imp_sth->moreResults = 0; imp_sth->dyn_execed = 0; imp_sth->exec_done = 0; @@ -3165,8 +3338,9 @@ while ((retcode = ct_results(cmd, &restype)) == CS_SUCCEED) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " st_next_result() -> ct_results(%d) == %d\n", - restype, retcode); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " st_next_result() -> ct_results(%d) == %d\n", restype, + retcode); if (restype == CS_CMD_FAIL) failFlag = 1; @@ -3185,7 +3359,8 @@ } retcode = describe(sth, imp_sth, restype); if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), "describe() retcode = %d\n", retcode); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + "describe() retcode = %d\n", retcode); if (restype == CS_STATUS_RESULT && (imp_sth->doProcStatus || (imp_sth->dyn_execed && imp_sth->type == 0))) { @@ -3195,7 +3370,9 @@ if (retcode == CS_SUCCEED) { imp_sth->lastProcStatus = imp_sth->coldata[0].value.i; if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), "describe() proc status code = %d\n", imp_sth->lastProcStatus); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + "describe() proc status code = %d\n", + imp_sth->lastProcStatus); if (imp_sth->lastProcStatus != 0) { failFlag = 2; } @@ -3215,8 +3392,8 @@ } } if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), "ct_results(%d) final retcode = %d\n", - restype, retcode); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + "ct_results(%d) final retcode = %d\n", restype, retcode); Done: /* The lasterr/lastsev is a hack to work around Sybase OpenClient, which @@ -3224,21 +3401,26 @@ inserting/updating data using ?-style placeholders. */ if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " st_next_result() -> lasterr = %d, lastsev = %d\n", imp_dbh->lasterr, imp_dbh->lastsev); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " st_next_result() -> lasterr = %d, lastsev = %d\n", + imp_dbh->lasterr, imp_dbh->lastsev); /* Only force a failure if there are no rows to be fetched (ie on a normal insert/update/delete operation */ if (!failFlag && imp_dbh->lasterr != 0 && imp_dbh->lastsev > 10) { if (imp_dbh->alwaysForceFailure || (restype != CS_STATUS_RESULT && restype != CS_ROW_RESULT && restype != CS_PARAM_RESULT - && restype != CS_CURSOR_RESULT && restype != CS_COMPUTE_RESULT )) { + && restype != CS_CURSOR_RESULT && restype != CS_COMPUTE_RESULT)) { failFlag = 3; if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " st_next_result() -> restype is not data result or syb_cancel_request_on_error is TRUE, force failFlag\n"); + PerlIO_printf( + DBIc_LOGPIO(imp_dbh), + " st_next_result() -> restype is not data result or syb_cancel_request_on_error is TRUE, force failFlag\n"); } else { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " st_next_result() -> restype is data result, do NOT force failFlag\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " st_next_result() -> restype is data result, do NOT force failFlag\n"); } } @@ -3250,7 +3432,8 @@ if (failFlag && (restype != CS_CMD_DONE && restype != CS_CMD_FAIL) && retcode != CS_FAIL) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " st_next_result() -> failFlag set - clear request\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " st_next_result() -> failFlag set - clear request\n"); syb_st_finish(sth, imp_sth); } @@ -3261,7 +3444,8 @@ if (failFlag || retcode == CS_FAIL || retcode == CS_CANCELED) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " st_next_result() -> force CS_CMD_FAIL return\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " st_next_result() -> force CS_CMD_FAIL return\n"); restype = CS_CMD_FAIL; } @@ -3271,7 +3455,8 @@ handle view after command completion. */ if (restype == CS_CMD_DONE || restype == CS_CMD_FAIL) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), + PerlIO_printf( + DBIc_LOGPIO(imp_dbh), " st_next_result() -> got %s: resetting ACTIVE, moreResults, dyn_execed, exec_done\n", restype == CS_CMD_DONE ? "CS_CMD_DONE" : "CS_CMD_FAIL"); clear_sth_flags(sth, imp_sth); @@ -3300,7 +3485,8 @@ /* FIXME - DBIS slow in threaded mode */ if (DBIS->debug >= 3 && retcode != CS_SUCCEED || reslen == CS_UNUSED) - PerlIO_printf(DBILOGFP, "cs_convert failed (_convert(%s, %d))", str, datafmt->datatype); + PerlIO_printf(DBILOGFP, "cs_convert failed (_convert(%s, %d))", str, + datafmt->datatype); if (len) { *len = reslen; @@ -3316,10 +3502,11 @@ CS_INT lastmsg = 0; CS_RETCODE ret; - memset((void*)&errmsg, 0, sizeof(CS_CLIENTMSG)); + memset((void*) &errmsg, 0, sizeof(CS_CLIENTMSG)); ret = cs_diag(context, CS_STATUS, CS_CLIENTMSG_TYPE, CS_UNUSED, &lastmsg); if (DBIc_DBISTATE(imp_sth)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_sth), "get_cs_msg -> cs_diag(CS_STATUS): lastmsg = %d (ret = %d)\n", + PerlIO_printf(DBIc_LOGPIO(imp_sth), + "get_cs_msg -> cs_diag(CS_STATUS): lastmsg = %d (ret = %d)\n", lastmsg, ret); if (ret != CS_SUCCEED) { warn("cs_diag(CS_STATUS) failed"); @@ -3327,16 +3514,15 @@ } ret = cs_diag(context, CS_GET, CS_CLIENTMSG_TYPE, lastmsg, &errmsg); if (DBIc_DBISTATE(imp_sth)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_sth), "get_cs_msg -> cs_diag(CS_GET) ret = %d\n", - ret); + PerlIO_printf(DBIc_LOGPIO(imp_sth), + "get_cs_msg -> cs_diag(CS_GET) ret = %d\n", ret); if (ret != CS_SUCCEED) { warn("cs_diag(CS_GET) failed"); return ret; } DBIh_SET_ERR_CHAR(sth, (imp_xxh_t *)imp_sth, NULL, CS_NUMBER(errmsg.msgnumber), - errmsg.msgstring, NULL, NULL) - ; + errmsg.msgstring, NULL, NULL); if (cslib_cb) { dSP; @@ -3380,7 +3566,7 @@ CS_SEVERITY(errmsg.msgnumber), CS_NUMBER(errmsg.msgnumber)); PerlIO_printf(DBIc_LOGPIO(imp_dbh), "Message String: %s\n", errmsg.msgstring); if(msg) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), "User Message: %s\n", msg); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), "User Message: %s\n", msg); /*fflush(stderr);*/ #endif return CS_FAIL; @@ -3433,21 +3619,33 @@ bytes = sizeof(CS_LONG); break; #if 0 - case CS_SENSITIVITY_TYPE: bytes = sizeof(CS_SENSITIVITY); break; - case CS_BOUNDARY_TYPE: bytes = sizeof(CS_BOUNDARY); break; + case CS_SENSITIVITY_TYPE: bytes = sizeof(CS_SENSITIVITY); break; + case CS_BOUNDARY_TYPE: bytes = sizeof(CS_BOUNDARY); break; #endif case CS_USHORT_TYPE: bytes = sizeof(CS_USHORT); break; #if defined(CS_DATE_TYPE) - case CS_DATE_TYPE: bytes = sizeof(CS_DATE); break; - case CS_TIME_TYPE: bytes = sizeof(CS_TIME); break; + case CS_DATE_TYPE: + bytes = sizeof(CS_DATE); + break; + case CS_TIME_TYPE: + bytes = sizeof(CS_TIME); + break; #endif #if defined(CS_BIGINT_TYPE) - case CS_BIGINT_TYPE: bytes = sizeof(CS_BIGINT); break; - case CS_USMALLINT_TYPE: bytes = sizeof(CS_USMALLINT); break; - case CS_UINT_TYPE: bytes = sizeof(CS_UINT); break; - case CS_UBIGINT_TYPE: bytes = sizeof(CS_UBIGINT); break; + case CS_BIGINT_TYPE: + bytes = sizeof(CS_BIGINT); + break; + case CS_USMALLINT_TYPE: + bytes = sizeof(CS_USMALLINT); + break; + case CS_UINT_TYPE: + bytes = sizeof(CS_UINT); + break; + case CS_UBIGINT_TYPE: + bytes = sizeof(CS_UBIGINT); + break; #endif default: warn("alloc_datatype: unkown type: %d", datatype); @@ -3486,9 +3684,9 @@ #endif for (i = 0; i < imp_sth->numCols; ++i) { - sprintf(name, ":p%d", i+1); + sprintf(name, ":p%d", i + 1); svp = hv_fetch(imp_sth->all_params_hv, name, strlen(name), 0); - phs = ((phs_t*)(void*)SvPVX(*svp)); + phs = ((phs_t*) (void*) SvPVX(*svp)); phs->datafmt.format = CS_FMT_UNUSED; phs->datafmt.count = 1; if (!phs->sv || !SvOK(phs->sv) || phs->sv == &PL_sv_undef) { @@ -3505,21 +3703,21 @@ #if 0 case CS_NUMERIC_TYPE: case CS_DECIMAL_TYPE: - if(_convert(&imp_sth->coldata[i].value.num, - imp_sth->coldata[i].ptr, LOCALE(imp_dbh), - &phs->datafmt, &vlen) != CS_SUCCEED) { - /* If the error handler returns CS_FAIL, then FAIL this + if(_convert(&imp_sth->coldata[i].value.num, + imp_sth->coldata[i].ptr, LOCALE(imp_dbh), + &phs->datafmt, &vlen) != CS_SUCCEED) { + /* If the error handler returns CS_FAIL, then FAIL this row! */ #if !defined(USE_CSLIB_CB) - if(get_cs_msg(context, con) != CS_SUCCEED) - goto FAIL; + if(get_cs_msg(context, con) != CS_SUCCEED) + goto FAIL; #else - warn("BLK _convert(CS_NUMERIC, %s) failed - see cslib error.", imp_sth->coldata[i].ptr); + warn("BLK _convert(CS_NUMERIC, %s) failed - see cslib error.", imp_sth->coldata[i].ptr); #endif - } - imp_sth->coldata[i].valuelen = (vlen != CS_UNUSED ? vlen : sizeof(imp_sth->coldata[i].value.num)); - ptr = &imp_sth->coldata[i].value.num; - break; + } + imp_sth->coldata[i].valuelen = (vlen != CS_UNUSED ? vlen : sizeof(imp_sth->coldata[i].value.num)); + ptr = &imp_sth->coldata[i].value.num; + break; #endif case CS_BINARY_TYPE: case CS_LONGBINARY_TYPE: @@ -3527,29 +3725,34 @@ case CS_TEXT_TYPE: case CS_IMAGE_TYPE: case CS_CHAR_TYPE: + /* For these types send data "as is" */ + ptr = imp_sth->coldata[i].ptr; + imp_sth->coldata[i].valuelen = slen; + break; #if defined(CS_UNICHAR_TYPE) case CS_UNICHAR_TYPE: -#endif /* For these types send data "as is" */ ptr = imp_sth->coldata[i].ptr; - imp_sth->coldata[i].valuelen = slen; + imp_sth->coldata[i].valuelen = slen * 2; break; +#endif default: /* for all others, call cs_convert() before sending */ if (!imp_sth->coldata[i].v_alloc) { imp_sth->coldata[i].value.p - = alloc_datatype(phs->datafmt.datatype, - &imp_sth->coldata[i].v_alloc); + = alloc_datatype(phs->datafmt.datatype, + &imp_sth->coldata[i].v_alloc); } if (_convert(imp_sth->coldata[i].value.p, - imp_sth->coldata[i].ptr, LOCALE(imp_dbh), &phs->datafmt, &vlen) != CS_SUCCEED) { + imp_sth->coldata[i].ptr, LOCALE(imp_dbh), + &phs->datafmt, &vlen) != CS_SUCCEED) { char msg[255]; /* If the error handler returns CS_FAIL, then FAIL this row! */ #if !defined(USE_CSLIB_CB) sprintf(msg, "cs_convert failed: column %d: (_convert(%s, %d))", - i + 1, (char *)imp_sth->coldata[i].ptr, + i + 1, (char *) imp_sth->coldata[i].ptr, phs->datafmt.datatype); ret = get_cs_msg(context, con, msg, sth, imp_sth); if (ret == CS_FAIL) @@ -3570,7 +3773,9 @@ ret = blk_bind(imp_sth->bcp_desc, i + 1, &phs->datafmt, ptr, &imp_sth->coldata[i].valuelen, &imp_sth->coldata[i].indicator); if (DBIc_DBISTATE(imp_dbh)->debug >= 5) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), "blk_bind %d -> '%s' (ret = %d)\n", i+1, imp_sth->coldata[i].ptr, ret); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + "blk_bind %d -> '%s' (ret = %d)\n", i + 1, + imp_sth->coldata[i].ptr, ret); if (ret != CS_SUCCEED) goto FAIL; } @@ -3601,21 +3806,27 @@ if (ct_command(imp_sth->cmd, CS_LANG_CMD, imp_sth->statement, CS_NULLTERM, CS_UNUSED) != CS_SUCCEED) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " cmd_execute() -> ct_command() failed (cmd=%x, statement=%s, imp_sth=%x)\n", imp_sth->cmd, imp_sth->statement, imp_sth); + PerlIO_printf( + DBIc_LOGPIO(imp_dbh), + " cmd_execute() -> ct_command() failed (cmd=%x, statement=%s, imp_sth=%x)\n", + imp_sth->cmd, imp_sth->statement, imp_sth); return -2; } if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " cmd_execute() -> ct_command() OK\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " cmd_execute() -> ct_command() OK\n"); } if (ct_send(imp_sth->cmd) != CS_SUCCEED) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " cmd_execute() -> ct_send() failed\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " cmd_execute() -> ct_send() failed\n"); return -2; } if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " cmd_execute() -> ct_send() OK\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " cmd_execute() -> ct_send() OK\n"); imp_sth->exec_done = 1; if (!imp_sth->connection) { @@ -3650,12 +3861,19 @@ if (!imp_sth->exec_done) { /* bind parameters if there are any */ + CS_INT rows; int i; SV **phs_svp; char namebuf[30]; int namelen; phs_t *phs; - int num_params = (int)DBIc_NUM_PARAMS(imp_sth); + int num_params = (int) DBIc_NUM_PARAMS(imp_sth); + + int foundOutput = 0; + boundparams_t *params = 0; + + /* malloc the maximum possible size for output parameters */ + params = malloc(sizeof(boundparams_t) * num_params ); for (i = 1; i <= num_params; ++i) { sprintf(namebuf, ":p%d", i); @@ -3663,15 +3881,67 @@ phs_svp = hv_fetch(imp_sth->all_params_hv, namebuf, namelen, 0); if (phs_svp == NULL) croak("Can't bind unknown placeholder '%s'", namebuf); - phs = (phs_t*)SvPVX(*phs_svp); /* placeholder struct */ + phs = (phs_t*) SvPVX(*phs_svp); /* placeholder struct */ - if (!_dbd_rebind_ph(sth, imp_sth, phs, 0)) + /* if the parameter is an output and it is bound as an inout, + * store the pointer, so we can use it for ct_bind */ + if ( phs->is_inout && phs->is_boundinout ) { + params[foundOutput].phs = phs; + foundOutput++; + } + + if (!_dbd_rebind_ph(sth, imp_sth, phs, 0)) { + free(params); return -2; + } } if (cmd_execute(sth, imp_sth) != 0) { + free(params); return -2; } + + /* if we have output parameters, fetch the result */ + if( foundOutput > 0 ) { + while (ct_results(imp_sth->cmd, &restype) == CS_SUCCEED && restype != CS_CMD_DONE) { + if (restype == CS_CMD_FAIL) { + free(params); + return -2; + } + /* ignore restype == CS_STATUS_RESULT */ + if (restype == CS_PARAM_RESULT) { + /* Since we have a parameter result, bind all the output parameters */ + for (i = 0; i < foundOutput; i++) { + phs = params[i].phs; + CS_DATAFMT datafmt; + /* find the maxlenght through ct_describe */ + if( ct_describe(imp_sth->cmd, i+1, &datafmt) != CS_SUCCEED) + croak("ct_describe() failed"); + + phs->datafmt.maxlength = datafmt.maxlength; + + /* Force to string with SvPOK_only (maybe use SvPV_force ). */ + SvPOK_only(phs->sv); + /* grow the output SV to the max length fetch will return */ + SvGROW(phs->sv, phs->datafmt.maxlength ); + + /* bind the SV through pointer to the physical string in the SV, + * store the returned length in the params array for adjustment after fetch */ + if( ct_bind(imp_sth->cmd, i+1, &phs->datafmt, SvPVX(phs->sv), ¶ms[i].len, 0) != CS_SUCCEED ) + syb_set_error(imp_dbh, -1, "ct_bind() for output param failed!"); + } + } + + /* fetch all results */ + while((ct_fetch(imp_sth->cmd, CS_UNUSED, CS_UNUSED, CS_UNUSED, &rows)) == CS_SUCCEED) { + } + } + /* set the output SV to the correct lenght */ + for (i = 0; i < foundOutput; i++) { + SvCUR_set(params[i].phs->sv, params[i].len); + } + } + free(params); } restype = st_next_result(sth, imp_sth); @@ -3688,7 +3958,8 @@ : imp_dbh->connection; if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_st_cancel() -> ct_cancel(CS_CANCEL_ATTN)\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_st_cancel() -> ct_cancel(CS_CANCEL_ATTN)\n"); if (ct_cancel(connection, NULL, CS_CANCEL_ATTN) == CS_FAIL) { ct_close(connection, CS_FORCE_CLOSE); @@ -3705,7 +3976,7 @@ D_imp_dbh_from_sth; if(DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " fix_fbav() -> num_fields = %d, numCols = %d\n", num_fields, imp_sth->numCols); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), " fix_fbav() -> num_fields = %d, numCols = %d\n", num_fields, imp_sth->numCols); /* XXX The code in the if() below is likely to break with new versions @@ -3714,21 +3985,21 @@ int isReadonly = SvREADONLY(av); ++clear_cache; if(isReadonly) - SvREADONLY_off(av); /* DBI sets this readonly */ + SvREADONLY_off(av); /* DBI sets this readonly */ i = imp_sth->numCols - 1; while(i >= num_fields) - av_store(av, i--, newSV(0)); + av_store(av, i--, newSV(0)); num_fields = AvFILL(av)+1; if(isReadonly) - SvREADONLY_on(av); /* protect against shift @$row etc */ + SvREADONLY_on(av); /* protect against shift @$row etc */ } else if(num_fields> imp_sth->numCols) { int isReadonly = SvREADONLY(av); if(isReadonly) - SvREADONLY_off(av); /* DBI sets this readonly */ + SvREADONLY_off(av); /* DBI sets this readonly */ av_fill(av, imp_sth->numCols - 1); num_fields = AvFILL(av)+1; if(isReadonly) - SvREADONLY_on(av); /* protect against shift @$row etc */ + SvREADONLY_on(av); /* protect against shift @$row etc */ ++clear_cache; } @@ -3744,19 +4015,19 @@ /* Code from DBI::DBD */ /* Clear cached statement handle attributes, if necessary */ - hv_delete((HV*)SvRV(sth), "NAME", 4, G_DISCARD); - hv_delete((HV*)SvRV(sth), "NULLABLE", 8, G_DISCARD); - hv_delete((HV*)SvRV(sth), "NUM_OF_FIELDS", 13, G_DISCARD); - hv_delete((HV*)SvRV(sth), "PRECISION", 9, G_DISCARD); - hv_delete((HV*)SvRV(sth), "SCALE", 5, G_DISCARD); - hv_delete((HV*)SvRV(sth), "TYPE", 4, G_DISCARD); + hv_delete((HV*) SvRV(sth), "NAME", 4, G_DISCARD); + hv_delete((HV*) SvRV(sth), "NULLABLE", 8, G_DISCARD); + hv_delete((HV*) SvRV(sth), "NUM_OF_FIELDS", 13, G_DISCARD); + hv_delete((HV*) SvRV(sth), "PRECISION", 9, G_DISCARD); + hv_delete((HV*) SvRV(sth), "SCALE", 5, G_DISCARD); + hv_delete((HV*) SvRV(sth), "TYPE", 4, G_DISCARD); } AV * syb_st_fetch(SV *sth, imp_sth_t *imp_sth) { dTHX; D_imp_dbh_from_sth; CS_COMMAND *cmd = imp_sth->cmd; - int num_fields; + CS_INT num_fields; int ChopBlanks; int i; AV *av; @@ -3767,21 +4038,29 @@ /* Check that execute() was executed sucessfully. This also implies */ /* that describe() executed sucessfuly so the memory buffers */ /* are allocated and bound. */ - if ( !DBIc_is(imp_sth, DBIcf_ACTIVE) || !imp_sth->exec_done) { + if (!DBIc_is(imp_sth, DBIcf_ACTIVE) || !imp_sth->exec_done) { return Nullav; } + /* + ** Find out how many columns there are in this result set. + */ + retcode = ct_res_info(cmd, CS_NUMDATA, &num_fields, CS_UNUSED, NULL); + if (retcode != CS_SUCCEED) + { + croak(" syb_st_fetch(): ct_res_info() failed"); + } + ChopBlanks = DBIc_has(imp_sth, DBIcf_ChopBlanks); TryAgain: retcode = ct_fetch(cmd, CS_UNUSED, CS_UNUSED, CS_UNUSED, &rows_read); - /* Use the actual number of fields... XXX */ - num_fields = DBIc_NUM_FIELDS(imp_sth); av = DBIc_DBISTATE(imp_dbh)->get_fbav(imp_sth); if (DBIc_DBISTATE(imp_dbh)->debug >= 4) { - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_st_fetch() -> ct_fetch() = %d (%d rows, %d cols)\n", + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_st_fetch() -> ct_fetch() = %d (%d rows, %d cols)\n", retcode, rows_read, num_fields); } @@ -3797,9 +4076,9 @@ if (DBIc_DBISTATE(imp_dbh)->debug >= 5) { /*char *text = neatsvpv(phs->sv,0);*/ - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_st_fetch() -> %d/%d/%d\n", - i, imp_sth->coldata[i].valuelen, - imp_sth->coldata[i].type); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_st_fetch() -> %d/%d/%d\n", i, + imp_sth->coldata[i].valuelen, imp_sth->coldata[i].type); } /* If we're beyond the number of items in this result set or: the data is null @@ -3807,10 +4086,10 @@ then: set sv to undef */ if (i >= imp_sth->numCols || imp_sth->coldata[i].indicator == CS_NULLDATA || (imp_sth->noBindBlob - && (imp_sth->datafmt[i].datatype == CS_TEXT_TYPE - || imp_sth->datafmt[i].datatype == CS_IMAGE_TYPE))) { + && (imp_sth->datafmt[i].datatype == CS_TEXT_TYPE + || imp_sth->datafmt[i].datatype == CS_IMAGE_TYPE))) { /* NULL data */ - (void)SvOK_off(sv); + (void) SvOK_off(sv); } else { #define DATE_BUFF_LEN 50 char buff[DATE_BUFF_LEN]; /* used for date conversions */ @@ -3819,9 +4098,11 @@ case CS_IMAGE_TYPE: case CS_TEXT_TYPE: case CS_CHAR_TYPE: + case CS_LONGCHAR_TYPE: len = imp_sth->coldata[i].valuelen; sv_setpvn(sv, imp_sth->coldata[i].value.c, len); - if (imp_sth->coldata[i].realType == CS_CHAR_TYPE + if ((imp_sth->coldata[i].realType == CS_CHAR_TYPE + || imp_sth->coldata[i].realType == CS_LONGCHAR_TYPE) && ChopBlanks) { char *p = SvEND(sv); int len = SvCUR(sv); @@ -3832,6 +4113,22 @@ *SvEND(sv) = '\0'; } } +#if defined(DBD_CAN_HANDLE_UTF8) + if (imp_dbh->enable_utf8 + && (imp_sth->coldata[i].realType == CS_UNICHAR_TYPE +#if defined(CS_UNITEXT_TYPE) + || imp_sth->coldata[i].realType == CS_UNITEXT_TYPE +#endif + )) { + U8 *value = SvPV_nolen(sv); + STRLEN len = SvCUR(sv); + + SvUTF8_off(sv); + if (is_high_bit_set(value, len) && is_utf8_string(value, len)) { + SvUTF8_on(sv); + } + } +#endif break; case CS_FLOAT_TYPE: sv_setnv(sv, imp_sth->coldata[i].value.f); @@ -3875,15 +4172,13 @@ #if defined(CS_DATE_TYPE) case CS_DATE_TYPE: len = date2str(&imp_sth->coldata[i].value.d, - &imp_sth->datafmt[i], - buff, DATE_BUFF_LEN, + &imp_sth->datafmt[i], buff, DATE_BUFF_LEN, imp_dbh->dateFmt, LOCALE(imp_dbh)); sv_setpvn(sv, buff, len); break; case CS_TIME_TYPE: len = time2str(&imp_sth->coldata[i].value.t, - &imp_sth->datafmt[i], - buff, DATE_BUFF_LEN, + &imp_sth->datafmt[i], buff, DATE_BUFF_LEN, imp_dbh->dateFmt, LOCALE(imp_dbh)); sv_setpvn(sv, buff, len); break; @@ -3910,8 +4205,8 @@ restype = st_next_result(sth, imp_sth); if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_st_fetch() -> st_next_results() == %d\n", - restype); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_st_fetch() -> st_next_results() == %d\n", restype); if (restype == CS_CMD_DONE || restype == CS_CMD_FAIL) { return Nullav; @@ -3928,25 +4223,21 @@ return Nullav; break; case -4: /*TDS_INVALID_PARAMETER:*/ - /* XXX is retcode right here */ - DBIh_SET_ERR_CHAR(sth, (imp_xxh_t*)imp_sth, Nullch, retcode, "TDS_INVALID_PARAMETER from ct_fetch", Nullch, Nullch) - ; - return Nullav; + /* XXX is retcode right here */ + DBIh_SET_ERR_CHAR(sth, (imp_xxh_t*)imp_sth, Nullch, retcode, "TDS_INVALID_PARAMETER from ct_fetch", Nullch, Nullch); + return Nullav; case -6: /* TDS_WRONG_STATE: */ - /* XXX is retcode right here */ - DBIh_SET_ERR_CHAR(sth, (imp_xxh_t*)imp_sth, Nullch, retcode, "TDS_WRONG_STATE from ct_fetch", Nullch, Nullch) - ; - return Nullav; + /* XXX is retcode right here */ + DBIh_SET_ERR_CHAR(sth, (imp_xxh_t*)imp_sth, Nullch, retcode, "TDS_WRONG_STATE from ct_fetch", Nullch, Nullch); + return Nullav; case CS_CANCELED: /* XXX is retcode right here */ - DBIh_SET_ERR_CHAR(sth, (imp_xxh_t*)imp_sth, Nullch, retcode, "Canceled", Nullch, Nullch) - ; + DBIh_SET_ERR_CHAR(sth, (imp_xxh_t*)imp_sth, Nullch, retcode, "Canceled", Nullch, Nullch); return Nullav; default: - warn("ct_fetch() returned an unexpected retcode %ld", (long)retcode); + warn("ct_fetch() returned an unexpected retcode %ld", (long) retcode); /* treat as a failure to avoid risk of an endless loop */ - DBIh_SET_ERR_CHAR(sth, (imp_xxh_t*)imp_sth, Nullch, retcode, "Unexpected retcode from ct_fetch", Nullch, Nullch) - ; + DBIh_SET_ERR_CHAR(sth, (imp_xxh_t*)imp_sth, Nullch, retcode, "Unexpected retcode from ct_fetch", Nullch, Nullch); return Nullav; } @@ -3958,7 +4249,7 @@ SAVETMPS; PUSHMARK(sp); - XPUSHs(sv_2mortal(newRV((SV*)av))); + XPUSHs(sv_2mortal(newRV((SV*) av))); PUTBACK; if ((count = perl_call_sv(imp_dbh->row_cb, G_SCALAR)) != 1) @@ -3979,6 +4270,15 @@ return av; } +#if defined(DBD_CAN_HANDLE_UTF8) +static int is_high_bit_set(const unsigned char *val, STRLEN size) +{ + while (*val && size--) + if (*val++ & 0x80) return 1; + return 0; +} +#endif + #if defined(NO_BLK) static int sth_blk_finish(imp_dbh_t *imp_dbh, imp_sth_t *imp_sth, SV *sth) { @@ -3987,7 +4287,8 @@ #else static int sth_blk_finish(imp_dbh_t *imp_dbh, imp_sth_t *imp_sth, SV *sth) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " sth_blk_finish() -> Checking for pending rows\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " sth_blk_finish() -> Checking for pending rows\n"); /* If there are any pending rows they should be rolled back, based on the principle that only *explicitly* commited data should be kept. */ @@ -4036,7 +4337,8 @@ imp_dbh->lasterr check unnecessary */ if (imp_dbh->flushFinish) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_st_finish() -> flushing\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_st_finish() -> flushing\n"); DBIh_CLEAR_ERROR(imp_sth); /* so syb_st_fetch can tell us when something goes wrong */ while (DBIc_ACTIVE(imp_sth) && !imp_dbh->isDead && imp_sth->exec_done && !SvTRUE(DBIc_ERR(imp_sth))) { @@ -4049,14 +4351,15 @@ if (DBIc_ACTIVE(imp_sth)) { #if defined(ROGUE) if(DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_st_finish() -> ct_cancel(CS_CANCEL_CURRENT)\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_st_finish() -> ct_cancel(CS_CANCEL_CURRENT)\n"); if(ct_cancel(NULL, imp_sth->cmd, CS_CANCEL_CURRENT) == CS_FAIL) { ct_close(connection, CS_FORCE_CLOSE); imp_dbh->isDead = 1; } #else if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_st_finish() -> ct_cancel(CS_CANCEL_ALL)\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_st_finish() -> ct_cancel(CS_CANCEL_ALL)\n"); if (ct_cancel(connection, NULL, CS_CANCEL_ALL) == CS_FAIL) { ct_close(connection, CS_FORCE_CLOSE); imp_dbh->isDead = 1; @@ -4075,21 +4378,25 @@ CS_INT restype; if (DBIc_DBISTATE(imp_sth)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_sth), " dealloc_dynamic: ct_dynamic(CS_DEALLOC) for %s\n", + PerlIO_printf(DBIc_LOGPIO(imp_sth), + " dealloc_dynamic: ct_dynamic(CS_DEALLOC) for %s\n", imp_sth->dyn_id); ret = ct_dynamic(imp_sth->cmd, CS_DEALLOC, imp_sth->dyn_id, CS_NULLTERM, NULL, CS_UNUSED); if (ret != CS_SUCCEED) { if (DBIc_DBISTATE(imp_sth)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_sth), " dealloc_dynamic: ct_dynamic(CS_DEALLOC) for %s FAILED\n", + PerlIO_printf( + DBIc_LOGPIO(imp_sth), + " dealloc_dynamic: ct_dynamic(CS_DEALLOC) for %s FAILED\n", imp_sth->dyn_id); return; } ret = ct_send(imp_sth->cmd); if (ret != CS_SUCCEED) { if (DBIc_DBISTATE(imp_sth)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_sth), " dealloc_dynamic: ct_send(CS_DEALLOC) for %s FAILED\n", + PerlIO_printf(DBIc_LOGPIO(imp_sth), + " dealloc_dynamic: ct_send(CS_DEALLOC) for %s FAILED\n", imp_sth->dyn_id); return; } @@ -4103,17 +4410,17 @@ char *key; I32 retlen; hv_iterinit(hv); - while ( (sv = hv_iternextsv(hv, &key, &retlen)) != NULL) { + while ((sv = hv_iternextsv(hv, &key, &retlen)) != NULL) { if (sv != &PL_sv_undef) { - phs_t *phs_tpl = (phs_t*)(void*)SvPVX(sv); + phs_t *phs_tpl = (phs_t*) (void*) SvPVX(sv); sv_free(phs_tpl->sv); } } - sv_free((SV*)imp_sth->all_params_hv); + sv_free((SV*) imp_sth->all_params_hv); } if (imp_sth->out_params_av) - sv_free((SV*)imp_sth->out_params_av); + sv_free((SV*) imp_sth->out_params_av); imp_sth->all_params_hv = NULL; imp_sth->out_params_av = NULL; @@ -4125,12 +4432,14 @@ dTHX; if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_st_destroy: called on %x...\n", imp_sth); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_st_destroy: called on %x...\n", imp_sth); if (PL_dirty) { DBIc_IMPSET_off(imp_sth); /* let DBI know we've done it */ if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_st_destroy: dirty set, skipping\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_st_destroy: dirty set, skipping\n"); return; } @@ -4143,9 +4452,10 @@ to re-execute non-dynamic statements... */ if (imp_sth->statement != NULL) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) { - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_st_destroy(): freeing imp_sth->statement\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_st_destroy(): freeing imp_sth->statement\n"); } - safefree(imp_sth->statement); + Safefree(imp_sth->statement); imp_sth->statement = NULL; imp_dbh->sql = NULL; } @@ -4157,31 +4467,36 @@ dropped the connection. I'm not sure if this is really a problem or if it can be ignored. XXX */ if (DBIc_DBISTATE(imp_dbh)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " ct_cmd_drop() -> CS_COMMAND %x\n", imp_sth->cmd); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " ct_cmd_drop() -> CS_COMMAND %x\n", imp_sth->cmd); ret = ct_cmd_drop(imp_sth->cmd); if (DBIc_DBISTATE(imp_dbh)->debug >= 3) { - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_st_destroy(): cmd dropped: %d\n", ret); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_st_destroy(): cmd dropped: %d\n", ret); } } /* reset BLK data, if needed */ if (imp_sth->bcp_desc) { /* XXX Should we call blk_done(CS_BLK_ALL) here??? */ if (DBIc_DBISTATE(imp_dbh)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_st_destroy(): blkCleanUp()\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_st_destroy(): blkCleanUp()\n"); sth_blk_finish(imp_dbh, imp_sth, sth); } if (imp_sth->connection) { ret = ct_close(imp_sth->connection, CS_FORCE_CLOSE); if (DBIc_DBISTATE(imp_dbh)->debug >= 3) { - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_st_destroy(): connection closed: %d\n", ret); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_st_destroy(): connection closed: %d\n", ret); } ct_con_drop(imp_sth->connection); } else { if (DBIc_ACTIVE(imp_sth)) { if (DBIc_DBISTATE(imp_dbh)->debug >= 3) { - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_st_destroy(): reset inUse flag\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " syb_st_destroy(): reset inUse flag\n"); } imp_dbh->inUse = 0; } @@ -4207,11 +4522,11 @@ SV *bufsv; if (buflen == 0) - buflen = imp_sth->datafmt[column-1].maxlength; + buflen = imp_sth->datafmt[column - 1].maxlength; if (DBIc_DBISTATE(imp_sth)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_sth), " ct_get_data(%d): buflen = %d\n", - column, buflen); + PerlIO_printf(DBIc_LOGPIO(imp_sth), + " ct_get_data(%d): buflen = %d\n", column, buflen); /* Fix PR/444: segfault if passed a non-reference SV for buffer */ if (!SvROK(bufrv)) { @@ -4221,15 +4536,16 @@ bufsv = SvRV(bufrv); Newz(902, buffer, buflen, char); - ret = ct_get_data(cmd, column, (CS_VOID*)buffer, buflen, &outlen); + ret = ct_get_data(cmd, column, (CS_VOID*) buffer, buflen, &outlen); if (outlen) { sv_setpvn(bufsv, buffer, outlen); } else { sv_setsv(bufsv, &PL_sv_undef); } if (DBIc_DBISTATE(imp_sth)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_sth), " ct_get_data(%d): got %d bytes (ret = %d)\n", - column, outlen, ret); + PerlIO_printf(DBIc_LOGPIO(imp_sth), + " ct_get_data(%d): got %d bytes (ret = %d)\n", column, + outlen, ret); Safefree(buffer); @@ -4248,16 +4564,17 @@ retcode = ct_send(imp_sth->cmd); if (DBIc_DBISTATE(imp_dbh)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " ct_finish_send(): ct_send() = %d\n", - retcode); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " ct_finish_send(): ct_send() = %d\n", retcode); if (retcode != CS_SUCCEED) { return 0; } while ((retcode = ct_results(imp_sth->cmd, &restype)) == CS_SUCCEED) { if (DBIc_DBISTATE(imp_dbh)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " ct_finish_send(): ct_results(%d) = %d\n", - restype, retcode); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " ct_finish_send(): ct_results(%d) = %d\n", restype, + retcode); if (restype == CS_PARAM_RESULT) { CS_DATAFMT datafmt; CS_INT count; @@ -4265,23 +4582,26 @@ retcode = ct_describe(imp_sth->cmd, 1, &datafmt); if (retcode != CS_SUCCEED) { if (DBIc_DBISTATE(imp_dbh)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " ct_finish_send(): ct_describe() failed\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " ct_finish_send(): ct_describe() failed\n"); return 0; } datafmt.maxlength = sizeof(imp_dbh->iodesc.timestamp); datafmt.format = CS_FMT_UNUSED; if ((retcode = ct_bind(imp_sth->cmd, 1, &datafmt, - (CS_VOID *)imp_dbh->iodesc.timestamp, + (CS_VOID *) imp_dbh->iodesc.timestamp, &imp_dbh->iodesc.timestamplen, NULL)) != CS_SUCCEED) { if (DBIc_DBISTATE(imp_dbh)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " ct_finish_send(): ct_bind() failed\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " ct_finish_send(): ct_bind() failed\n"); return 0; } retcode = ct_fetch(imp_sth->cmd, CS_UNUSED, CS_UNUSED, CS_UNUSED, &count); if (retcode != CS_SUCCEED) { if (DBIc_DBISTATE(imp_dbh)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " ct_finish_send(): ct_fetch() failed\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " ct_finish_send(): ct_fetch() failed\n"); return 0; } /* success... so cancel the rest of this result set */ @@ -4289,7 +4609,8 @@ retcode = ct_cancel(NULL, imp_sth->cmd, CS_CANCEL_CURRENT); if (retcode != CS_SUCCEED) { if (DBIc_DBISTATE(imp_dbh)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " ct_finish_send(): ct_fetch() failed\n"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " ct_finish_send(): ct_fetch() failed\n"); return 0; } } @@ -4302,8 +4623,8 @@ dTHX; if (DBIc_DBISTATE(imp_sth)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_sth), " ct_send_data(): sending buffer size %d bytes\n", - size); + PerlIO_printf(DBIc_LOGPIO(imp_sth), + " ct_send_data(): sending buffer size %d bytes\n", size); return ct_send_data(imp_sth->cmd, buffer, size) == CS_SUCCEED; } @@ -4320,23 +4641,25 @@ if (attr && attr != &PL_sv_undef && SvROK(attr)) { SV **svp; - svp = hv_fetch((HV*)SvRV(attr), "total_txtlen", 12, 0); + svp = hv_fetch((HV*) SvRV(attr), "total_txtlen", 12, 0); if (svp && SvGMAGICAL(*svp)) /* eg if from tainted expression */ mg_get(*svp); if (svp && SvIOK(*svp)) imp_dbh->iodesc.total_txtlen = SvIV(*svp); if (DBIc_DBISTATE(imp_dbh)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " ct_data_info(): set total_txtlen to %d\n", + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " ct_data_info(): set total_txtlen to %d\n", imp_dbh->iodesc.total_txtlen); - svp = hv_fetch((HV*)SvRV(attr), "log_on_update", 13, 0); + svp = hv_fetch((HV*) SvRV(attr), "log_on_update", 13, 0); if (svp && SvGMAGICAL(*svp)) /* eg if from tainted expression */ mg_get(*svp); if (svp && SvIOK(*svp)) imp_dbh->iodesc.log_on_update = SvIV(*svp); if (DBIc_DBISTATE(imp_dbh)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " ct_data_info(): set log_on_update to %d\n", + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " ct_data_info(): set log_on_update to %d\n", imp_dbh->iodesc.log_on_update); } } @@ -4345,15 +4668,16 @@ column = CS_UNUSED; } else { if (DBIc_DBISTATE(imp_dbh)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " ct_data_info(): get IODESC for column %d\n", - column); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " ct_data_info(): get IODESC for column %d\n", column); } ret = ct_data_info(cmd, action, column, &imp_dbh->iodesc); if (action == CS_GET && DBIc_DBISTATE(imp_dbh)->debug >= 4) { - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " ct_data_info(): ret = %d, total_txtlen = %d\n", - ret, imp_dbh->iodesc.total_txtlen); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " ct_data_info(): ret = %d, total_txtlen = %d\n", ret, + imp_dbh->iodesc.total_txtlen); } else if (DBIc_DBISTATE(imp_dbh)->debug >= 4) { PerlIO_printf(DBIc_LOGPIO(imp_dbh), " ct_data_info(): ret = %d\n", ret); @@ -4373,27 +4697,27 @@ #define s_A(str) { str, sizeof(str)-1 } static T_st_params S_st_fetch_params[] = { s_A("NUM_OF_PARAMS"), /* 0 */ - s_A("NUM_OF_FIELDS"), /* 1 */ - s_A("NAME"), /* 2 */ - s_A("NULLABLE"), /* 3 */ - s_A("TYPE"), /* 4 */ - s_A("PRECISION"), /* 5 */ - s_A("SCALE"), /* 6 */ - s_A("syb_more_results"), /* 7 */ - s_A("LENGTH"), /* 8 */ - s_A("syb_types"), /* 9 */ - s_A("syb_result_type"), /* 10 */ - s_A("LongReadLen"), /* 11 */ - s_A("syb_proc_status"), /* 12 */ - s_A("syb_do_proc_status"), /* 13 */ - s_A("syb_no_bind_blob"), /* 14 */ - s_A("CursorName"), /* 15 - PR/394 */ - s_A(""), /* END */ +s_A("NUM_OF_FIELDS"), /* 1 */ +s_A("NAME"), /* 2 */ +s_A("NULLABLE"), /* 3 */ +s_A("TYPE"), /* 4 */ +s_A("PRECISION"), /* 5 */ +s_A("SCALE"), /* 6 */ +s_A("syb_more_results"), /* 7 */ +s_A("LENGTH"), /* 8 */ +s_A("syb_types"), /* 9 */ +s_A("syb_result_type"), /* 10 */ +s_A("LongReadLen"), /* 11 */ +s_A("syb_proc_status"), /* 12 */ +s_A("syb_do_proc_status"), /* 13 */ +s_A("syb_no_bind_blob"), /* 14 */ +s_A("CursorName"), /* 15 - PR/394 */ +s_A(""), /* END */ }; static T_st_params S_st_store_params[] = { s_A("syb_do_proc_status"), /* 0 */ - s_A("syb_no_bind_blob"), /* 1 */ - s_A(""), /* END */ +s_A("syb_no_bind_blob"), /* 1 */ +s_A(""), /* END */ }; #undef s_A @@ -4431,93 +4755,91 @@ switch (par - S_st_fetch_params) { AV *av; - case 0: /* NUM_OF_PARAMS */ - return Nullsv; /* handled by DBI */ - case 1: /* NUM_OF_FIELDS */ - retsv = newSViv(i); - break; - case 2: /* NAME */ - av = newAV(); - retsv = newRV(sv_2mortal((SV*)av)); - while (--i >= 0) - av_store(av, i, newSVpv(imp_sth->datafmt[i].name, 0)); - break; - case 3: /* NULLABLE */ - av = newAV(); - retsv = newRV(sv_2mortal((SV*)av)); - while (--i >= 0) - av_store(av, i, - (imp_sth->datafmt[i].status & CS_CANBENULL) ? newSViv(1) - : newSViv(0)); - break; - case 4: /* TYPE */ - av = newAV(); - retsv = newRV(sv_2mortal((SV*)av)); - while (--i >= 0) - av_store(av, i, newSViv(map_syb_types(imp_sth->coldata[i].realType))); - break; - case 5: /* PRECISION */ - av = newAV(); - retsv = newRV(sv_2mortal((SV*)av)); - while (--i >= 0) - av_store( - av, - i, - newSViv(imp_sth->datafmt[i].precision ? imp_sth->datafmt[i].precision - : imp_sth->coldata[i].realLength)); - break; - case 6: /* SCALE */ - av = newAV(); - retsv = newRV(sv_2mortal((SV*)av)); - while (--i >= 0) { - switch (imp_sth->coldata[i].realType) { - case CS_NUMERIC_TYPE: - case CS_DECIMAL_TYPE: - av_store(av, i, newSViv(imp_sth->datafmt[i].scale)); - break; - default: - av_store(av, i, newSVsv(&PL_sv_undef)); - } +case 0: /* NUM_OF_PARAMS */ + return Nullsv; /* handled by DBI */ +case 1: /* NUM_OF_FIELDS */ + retsv = newSViv(i); + break; +case 2: /* NAME */ + av = newAV(); + retsv = newRV(sv_2mortal((SV*) av)); + while (--i >= 0) + av_store(av, i, newSVpv(imp_sth->datafmt[i].name, 0)); + break; +case 3: /* NULLABLE */ + av = newAV(); + retsv = newRV(sv_2mortal((SV*) av)); + while (--i >= 0) + av_store(av, i, + (imp_sth->datafmt[i].status & CS_CANBENULL) ? newSViv(1) + : newSViv(0)); + break; +case 4: /* TYPE */ + av = newAV(); + retsv = newRV(sv_2mortal((SV*) av)); + while (--i >= 0) + av_store(av, i, newSViv(map_syb_types(imp_sth->coldata[i].realType))); + break; +case 5: /* PRECISION */ + av = newAV(); + retsv = newRV(sv_2mortal((SV*) av)); + while (--i >= 0) + av_store(av, i, newSViv( + imp_sth->datafmt[i].precision ? imp_sth->datafmt[i].precision + : imp_sth->coldata[i].realLength)); + break; +case 6: /* SCALE */ + av = newAV(); + retsv = newRV(sv_2mortal((SV*) av)); + while (--i >= 0) { + switch (imp_sth->coldata[i].realType) { + case CS_NUMERIC_TYPE: + case CS_DECIMAL_TYPE: + av_store(av, i, newSViv(imp_sth->datafmt[i].scale)); + break; + default: + av_store(av, i, newSVsv(&PL_sv_undef)); } - break; - case 7: - retsv = newSViv(imp_sth->moreResults); - break; - case 8: - av = newAV(); - retsv = newRV(sv_2mortal((SV*)av)); - while (--i >= 0) - av_store(av, i, newSViv(imp_sth->coldata[i].realLength)); - break; - case 9: /* syb_types: native datatypes */ - av = newAV(); - retsv = newRV(sv_2mortal((SV*)av)); - while (--i >= 0) - av_store(av, i, newSViv(imp_sth->coldata[i].realType)); - break; - case 10: - retsv = newSViv(imp_sth->lastResType); - break; - case 11: - retsv = newSViv(DBIc_LongReadLen(imp_sth)); - break; - case 12: - retsv = newSViv(imp_sth->lastProcStatus); - break; - case 13: - retsv = newSViv(imp_sth->doProcStatus); - break; - case 14: - retsv = newSViv(imp_sth->noBindBlob); - break; - case 15: - retsv = &PL_sv_undef; /* fix for PR/394 */ - break; - default: - return Nullsv; + } + break; +case 7: + retsv = newSViv(imp_sth->moreResults); + break; +case 8: + av = newAV(); + retsv = newRV(sv_2mortal((SV*) av)); + while (--i >= 0) + av_store(av, i, newSViv(imp_sth->coldata[i].realLength)); + break; +case 9: /* syb_types: native datatypes */ + av = newAV(); + retsv = newRV(sv_2mortal((SV*) av)); + while (--i >= 0) + av_store(av, i, newSViv(imp_sth->coldata[i].realType)); + break; +case 10: + retsv = newSViv(imp_sth->lastResType); + break; +case 11: + retsv = newSViv(DBIc_LongReadLen(imp_sth)); + break; +case 12: + retsv = newSViv(imp_sth->lastProcStatus); + break; +case 13: + retsv = newSViv(imp_sth->doProcStatus); + break; +case 14: + retsv = newSViv(imp_sth->noBindBlob); + break; +case 15: + retsv = &PL_sv_undef; /* fix for PR/394 */ + break; +default: + return Nullsv; } - if (retsv == &sv_no || retsv == &sv_yes || retsv == &PL_sv_undef) + if (retsv == &PL_sv_no || retsv == &PL_sv_yes || retsv == &PL_sv_undef) return retsv; return sv_2mortal(retsv); @@ -4530,7 +4852,8 @@ T_st_params *par; if (DBIc_DBISTATE(imp_sth)->debug >= 3) { - PerlIO_printf(DBIc_LOGPIO(imp_sth), " syb_st_STORE(): key = %s\n", key); + PerlIO_printf(DBIc_LOGPIO(imp_sth), " syb_st_STORE(): key = %s\n", + key); } for (par = S_st_store_params; par->len > 0; par++) @@ -4541,7 +4864,9 @@ return FALSE; if (DBIc_DBISTATE(imp_sth)->debug >= 3) { - PerlIO_printf(DBIc_LOGPIO(imp_sth), " syb_st_STORE(): storing %d for key = %s\n", SvTRUE(valuesv), key); + PerlIO_printf(DBIc_LOGPIO(imp_sth), + " syb_st_STORE(): storing %d for key = %s\n", + SvTRUE(valuesv), key); } switch (par - S_st_store_params) { case 0: @@ -4597,11 +4922,9 @@ } #if defined(CS_DATE_TYPE) -static int -date2str(CS_DATE *d, CS_DATAFMT *srcfmt, - char *buff, CS_INT len, int type, CS_LOCALE *locale) -{ - if(type == 0) { +static int date2str(CS_DATE *d, CS_DATAFMT *srcfmt, char *buff, CS_INT len, + int type, CS_LOCALE *locale) { + if (type == 0) { CS_DATAFMT dstfmt; memset(&dstfmt, 0, sizeof(dstfmt)); @@ -4615,23 +4938,15 @@ } else { CS_DATEREC rec; cs_dt_crack(context, CS_DATE_TYPE, d, &rec); - if(type == 2) { + if (type == 2) { sprintf(buff, "%4.4d-%2.2d-%2.2dT%2.2d:%2.2d:%2.2d.%3.3dZ", - rec.dateyear, - rec.datemonth + 1, - rec.datedmonth, - rec.datehour, - rec.dateminute, - rec.datesecond, + rec.dateyear, rec.datemonth + 1, rec.datedmonth, + rec.datehour, rec.dateminute, rec.datesecond, rec.datemsecond); } else { sprintf(buff, "%4.4d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d.%3.3d", - rec.dateyear, - rec.datemonth + 1, - rec.datedmonth, - rec.datehour, - rec.dateminute, - rec.datesecond, + rec.dateyear, rec.datemonth + 1, rec.datedmonth, + rec.datehour, rec.dateminute, rec.datesecond, rec.datemsecond); } @@ -4641,11 +4956,9 @@ return 0; } -static int -time2str(CS_TIME *t, CS_DATAFMT *srcfmt, - char *buff, CS_INT len, int type, CS_LOCALE *locale) -{ - if(type == 0) { +static int time2str(CS_TIME *t, CS_DATAFMT *srcfmt, char *buff, CS_INT len, + int type, CS_LOCALE *locale) { + if (type == 0) { CS_DATAFMT dstfmt; memset(&dstfmt, 0, sizeof(dstfmt)); @@ -4659,23 +4972,15 @@ } else { CS_DATEREC rec; cs_dt_crack(context, CS_TIME_TYPE, t, &rec); - if(type == 2) { + if (type == 2) { sprintf(buff, "%4.4d-%2.2d-%2.2dT%2.2d:%2.2d:%2.2d.%3.3dZ", - rec.dateyear, - rec.datemonth + 1, - rec.datedmonth, - rec.datehour, - rec.dateminute, - rec.datesecond, + rec.dateyear, rec.datemonth + 1, rec.datedmonth, + rec.datehour, rec.dateminute, rec.datesecond, rec.datemsecond); } else { sprintf(buff, "%4.4d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d.%3.3d", - rec.dateyear, - rec.datemonth + 1, - rec.datedmonth, - rec.datehour, - rec.dateminute, - rec.datesecond, + rec.dateyear, rec.datemonth + 1, rec.datedmonth, + rec.datehour, rec.dateminute, rec.datesecond, rec.datemsecond); } @@ -4708,7 +5013,7 @@ if (type) { /* RPC call */ if ((p = strchr(str, '.'))) - datafmt->scale = strlen(p+1); + datafmt->scale = strlen(p + 1); else datafmt->scale = 0; datafmt->precision = strlen(str); @@ -4797,19 +5102,19 @@ to infer whether to advance or not, but it's just as easy to explicitly check. */ if (str[0] == '0' && str[1] == 'x') - str+=2; + str += 2; /* The length of 'str' _should_ be even, but we go thru some acrobatics to handle an odd length. We won't flag it as invalid, just pretend it's okay. */ - b_len = (strlen(str)+1) / 2; - b = (CS_BINARY *)safemalloc(b_len); + b_len = (strlen(str) + 1) / 2; + b = (CS_BINARY *) safemalloc(b_len); memset(b, 0, b_len); memset(&s, '\0', 3); /* Pack the characters */ b_ptr = b; - for (i=0; iname, phs->varname, text); if (SvOK(phs->sv)) PerlIO_printf(DBIc_LOGPIO(imp_dbh), "size %ld/%ld/%ld, ", - (long)SvCUR(phs->sv),(long)SvLEN(phs->sv),phs->maxlen); + (long) SvCUR(phs->sv), (long) SvLEN(phs->sv), phs->maxlen); else PerlIO_printf(DBIc_LOGPIO(imp_dbh), "NULL, "); PerlIO_printf(DBIc_LOGPIO(imp_dbh), "ptype %d, otype %d%s)\n", - (int)SvTYPE(phs->sv), phs->ftype, - (phs->is_inout) ? ", inout" : ""); + (int) SvTYPE(phs->sv), phs->ftype, (phs->is_inout) ? ", inout" + : ""); } /* At the moment we always do sv_setsv() and rebind. */ @@ -4856,7 +5161,7 @@ #if 0 if (phs->is_inout) { /* XXX */ if (SvREADONLY(phs->sv)) - croak(no_modify); + croak(no_modify); /* phs->sv _is_ the real live variable, it may 'mutate' later */ /* pre-upgrade high to reduce risk of SvPVX realloc/move */ (void)SvUPGRADE(phs->sv, SVt_PVNV); @@ -4869,7 +5174,7 @@ } #else /* phs->sv is copy of real variable, upgrade to at least string */ - (void)SvUPGRADE(phs->sv, SVt_PV); + (void) SvUPGRADE(phs->sv, SVt_PV); #endif /* At this point phs->sv must be at least a PV with a valid buffer, */ @@ -4895,7 +5200,8 @@ break; case CS_NUMERIC_TYPE: case CS_DECIMAL_TYPE: - n_value = to_numeric(phs->sv_buf, LOCALE(imp_dbh), &phs->datafmt, imp_sth->type); + n_value = to_numeric(phs->sv_buf, LOCALE(imp_dbh), &phs->datafmt, + imp_sth->type); phs->datafmt.datatype = CS_NUMERIC_TYPE; value = &n_value; value_len = sizeof(n_value); @@ -4936,7 +5242,7 @@ value_len = CS_NULLTERM; /* PR/464: datetime values get converted to "jan 1 1900" if turned into a single space */ - if (*(char*)value == 0) { + if (*(char*) value == 0) { value = NULL; value_len = CS_UNUSED; } @@ -4947,7 +5253,7 @@ value = phs->sv_buf; /*value_len = CS_NULLTERM;*//*Allow embedded NUL bytes in strings?*/ /* PR/446: should an empty string cause a NULL, or not? */ - if (*(char*)value == 0) { + if (*(char*) value == 0) { if (imp_dbh->bindEmptyStringNull) { value = NULL; value_len = CS_UNUSED; @@ -4965,16 +5271,19 @@ value = NULL; } phs->sv_type = SvTYPE(phs->sv); /* part of mutation check */ - phs->maxlen = SvLEN(phs->sv)-1; /* avail buffer space */ + phs->maxlen = SvLEN(phs->sv) - 1; /* avail buffer space */ /* value_len has current value length */ if (DBIc_DBISTATE(imp_dbh)->debug >= 4) { - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " bind %s <== '%.100s' (size %d, ok %d)\n", - phs->name, phs->sv_buf, (long)phs->maxlen, SvOK(phs->sv)?1:0); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " bind %s <== '%.100s' (size %d, ok %d)\n", phs->name, + phs->sv_buf, (long) phs->maxlen, SvOK(phs->sv) ? 1 : 0); } if (DBIc_DBISTATE(imp_dbh)->debug >= 4) { - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " datafmt: type=%d, name=%s, status=%d, len=%d\n", - phs->datafmt.datatype, phs->datafmt.name, phs->datafmt.status, value_len); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " datafmt: type=%d, name=%s, status=%d, len=%d\n", + phs->datafmt.datatype, phs->datafmt.name, phs->datafmt.status, + value_len); PerlIO_printf(DBIc_LOGPIO(imp_dbh), " saved type: %d\n", datatype); } @@ -5013,7 +5322,7 @@ phs->datafmt.datatype = datatype; if (free_value && value != NULL) - safefree(value); + Safefree(value); return (rc == CS_SUCCEED); } @@ -5047,7 +5356,7 @@ name = SvPV(ph_namesv, name_len); } if (SvNIOKp(ph_namesv) || (name && isDIGIT(name[0]))) { - sprintf(namebuf, ":p%d", (int)SvIV(ph_namesv)); + sprintf(namebuf, ":p%d", (int) SvIV(ph_namesv)); name = namebuf; name_len = strlen(name); } @@ -5056,17 +5365,21 @@ croak("Can't bind non-scalar value (currently)"); #if 0 if (SvTYPE(newvalue) == SVt_PVLV && is_inout) /* may allow later */ - croak("Can't bind ``lvalue'' mode scalar as inout parameter (currently)"); + croak("Can't bind ``lvalue'' mode scalar as inout parameter (currently)"); #endif if (DBIc_DBISTATE(imp_sth)->debug >= 3) - PerlIO_printf(DBIc_LOGPIO(imp_sth), "bind %s <== '%.200s' (attribs: %s)\n", - name, SvPV(newvalue,lna), attribs ? SvPV(attribs,lna) : "" ); + PerlIO_printf(DBIc_LOGPIO(imp_sth), + "bind %s <== '%.200s' (attribs: %s)\n", name, SvPV(newvalue, + lna), attribs ? SvPV(attribs, lna) : ""); phs_svp = hv_fetch(imp_sth->all_params_hv, name, name_len, 0); if (phs_svp == NULL) croak("Can't bind unknown placeholder '%s'", name); - phs = (phs_t*)SvPVX(*phs_svp); /* placeholder struct */ + phs = (phs_t*) SvPVX(*phs_svp); /* placeholder struct */ + + if (DBIc_DBISTATE(imp_sth)->debug >= 3) + PerlIO_printf(DBIc_LOGPIO(imp_sth), " parameter is output [%s]\n", is_inout ? "true" : "false" ); if (phs->sv == &PL_sv_undef) { /* first bind for this placeholder */ phs->sql_type = (sql_type) ? sql_type : SQL_CHAR; @@ -5089,7 +5402,7 @@ ++imp_sth->has_inout_params; /* build array of phs's so we can deal with out vars fast */ if (!imp_sth->out_params_av) - imp_sth->out_params_av = newAV(); + imp_sth->out_params_av = newAV(); av_push(imp_sth->out_params_av, SvREFCNT_inc(*phs_svp)); } #endif @@ -5112,6 +5425,12 @@ if (phs->sv == &PL_sv_undef) /* (first time bind) */ phs->sv = newSV(0); sv_setsv(phs->sv, newvalue); + phs->is_boundinout = 0; + } else { + phs->sv = SvREFCNT_inc(newvalue); /* Take a reference to the input variable */ + phs->is_boundinout = 1; + if (DBIc_DBISTATE(imp_sth)->debug >= 3) + PerlIO_printf(DBIc_LOGPIO(imp_sth), " parameter is bound as inout\n"); } /* BLK binding done at execute time, in a loop */ @@ -5121,6 +5440,7 @@ return 1; /* _dbd_rebind_ph(sth, imp_sth, phs, 0); */ } + static CS_RETCODE fetch_data(imp_dbh_t *imp_dbh, CS_COMMAND *cmd) { dTHX; CS_RETCODE retcode; @@ -5232,7 +5552,7 @@ ** We're done processing rows. Let's check the final return ** value of ct_fetch(). */ - switch ((int)retcode) { + switch ((int) retcode) { case CS_END_DATA: retcode = CS_SUCCEED; break; @@ -5308,7 +5628,8 @@ case CS_DATETIME4_TYPE: return 9; #if defined(CS_TIME_TYPE) - case CS_TIME_TYPE: return 10; + case CS_TIME_TYPE: + return 10; #endif case CS_MONEY_TYPE: case CS_MONEY4_TYPE: @@ -5399,8 +5720,7 @@ } if (DBIc_DBISTATE(imp_dbh)->debug >= 4) { PerlIO_printf(DBIc_LOGPIO(imp_dbh), - " syb_blk_init(): table=%s\n", - table); + " syb_blk_init(): table=%s\n", table); } /* If AutoCommit is "officially" off here, then we need to make sure @@ -5416,7 +5736,7 @@ if (ret != CS_SUCCEED) goto FAIL; ret = blk_props(imp_sth->bcp_desc, CS_SET, BLK_IDENTITY, - (CS_VOID*)&imp_sth->bcpIdentityFlag, CS_UNUSED, NULL); + (CS_VOID*) &imp_sth->bcpIdentityFlag, CS_UNUSED, NULL); if (ret != CS_SUCCEED) goto FAIL; @@ -5438,15 +5758,16 @@ for (i = 1; i <= num_cols; ++i) { sprintf(name, ":p%d", i); svp = hv_fetch(imp_sth->all_params_hv, name, strlen(name), 0); - phs = ((phs_t*)(void*)SvPVX(*svp)); + phs = ((phs_t*) (void*) SvPVX(*svp)); memset(&phs->datafmt, 0, sizeof(CS_DATAFMT)); ret = blk_describe(imp_sth->bcp_desc, i, &phs->datafmt); if (DBIc_DBISTATE(imp_dbh)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_blk_init: blk_describe()==%d col %d, type %d, status %d, length %d\n", - ret, - i, phs->datafmt.datatype, - phs->datafmt.status, phs->datafmt.maxlength); + PerlIO_printf( + DBIc_LOGPIO(imp_dbh), + " syb_blk_init: blk_describe()==%d col %d, type %d, status %d, length %d\n", + ret, i, phs->datafmt.datatype, phs->datafmt.status, + phs->datafmt.maxlength); if (ret != CS_SUCCEED) goto FAIL; @@ -5489,7 +5810,9 @@ if (imp_sth->bcp_desc) { CS_INT ret = blk_drop(imp_sth->bcp_desc); if (DBIc_DBISTATE(imp_dbh)->debug >= 4) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " blkCleanUp -> blk_drop(%d) = %d\n", imp_sth->bcp_desc, ret); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " blkCleanUp -> blk_drop(%d) = %d\n", imp_sth->bcp_desc, + ret); imp_sth->bcp_desc = NULL; } } @@ -5511,11 +5834,11 @@ if (!p || !*p) goto FAIL; strncpy(table, p, maxwidth); - safefree(ptr); + Safefree(ptr); return 1; - FAIL: safefree(ptr); + FAIL: Safefree(ptr); return 0; } @@ -5542,19 +5865,20 @@ CS_BOOL value; CS_RETCODE ret; int current = DBIc_is(imp_dbh, DBIcf_AutoCommit); - - if(!imp_dbh->init_done) { + + if (!imp_dbh->init_done) { imp_dbh->init_done = 1; if (DBIc_DBISTATE(imp_dbh)->debug >= 5) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " toggle_autocommit: init_done not set, no action\n"); - + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " toggle_autocommit: init_done not set, no action\n"); + return TRUE; } if (DBIc_DBISTATE(imp_dbh)->debug >= 5) - PerlIO_printf(DBIc_LOGPIO(imp_dbh), " toggle_autocommit: current = %s, new = %s\n", - current ? "on" : "off", - flag ? "on" : "off"); + PerlIO_printf(DBIc_LOGPIO(imp_dbh), + " toggle_autocommit: current = %s, new = %s\n", + current ? "on" : "off", flag ? "on" : "off"); if (flag) { if (!current) { /* Going from OFF to ON - so force a COMMIT on any open diff -Nru libdbd-sybase-perl-1.09/dbdimp.h libdbd-sybase-perl-1.14/dbdimp.h --- libdbd-sybase-perl-1.09/dbdimp.h 2008-08-31 12:08:17.000000000 +0000 +++ libdbd-sybase-perl-1.14/dbdimp.h 2011-04-25 09:00:44.000000000 +0000 @@ -1,208 +1,214 @@ /* - $Id: dbdimp.h,v 1.41 2008/08/31 12:08:17 mpeppler Exp $ + $Id: dbdimp.h,v 1.43 2011/04/25 08:59:17 mpeppler Exp $ - Copyright (c) 1997-2008 Michael Peppler + Copyright (c) 1997-2011 Michael Peppler - You may distribute under the terms of either the GNU General Public - License or the Artistic License, as specified in the Perl README file. + You may distribute under the terms of either the GNU General Public + License or the Artistic License, as specified in the Perl README file. - Based on DBD::Oracle dbdimp.h, Copyright (c) 1994,1995 Tim Bunce + Based on DBD::Oracle dbdimp.h, Copyright (c) 1994,1995 Tim Bunce -*/ + */ typedef struct imp_fbh_st imp_fbh_t; /* -** Maximum character buffer for displaying a column -*/ + ** Maximum character buffer for displaying a column + */ #define MAX_CHAR_BUF 1024 - -typedef struct _col_data -{ - CS_SMALLINT indicator; - CS_INT type; - CS_INT realType; - CS_INT realLength; - union { - CS_CHAR *c; - CS_INT i; +typedef struct _col_data { + CS_SMALLINT indicator; + CS_INT type; + CS_INT realType; + CS_INT realLength; + union { + CS_CHAR *c; + CS_INT i; #if defined(CS_UINT_TYPE) - CS_UINT ui; - CS_BIGINT bi; - CS_UBIGINT ubi; + CS_UINT ui; + CS_BIGINT bi; + CS_UBIGINT ubi; #endif - CS_FLOAT f; - CS_DATETIME dt; + CS_FLOAT f; + CS_DATETIME dt; #if defined(CS_DATE_TYPE) - CS_DATE d; - CS_TIME t; + CS_DATE d; + CS_TIME t; #endif - CS_MONEY mn; - CS_NUMERIC num; - CS_VOID *p; - } value; - int v_alloc; - CS_INT valuelen; - CS_VOID *ptr; + CS_MONEY mn; + CS_NUMERIC num; + CS_VOID *p; + } value; + int v_alloc; + CS_INT valuelen; + CS_VOID *ptr; } ColData; - struct imp_drh_st { - dbih_drc_t com; /* MUST be first element in structure */ + dbih_drc_t com; /* MUST be first element in structure */ }; #define MAX_SQL_SIZE 255 /* Define dbh implementor data structure */ struct imp_dbh_st { - dbih_dbc_t com; /* MUST be first element in structure */ - - CS_CONNECTION *connection; - CS_LOCALE *locale; - CS_IODESC iodesc; - char tranName[32]; - int inTransaction; - int doRealTran; - int chainedSupported; - int quotedIdentifier; - int useBin0x; - int binaryImage; - int dateFmt; /* 0 for Sybase native, 1 for ISO8601 */ - int optSupported; /* 0 if the server doesn't support ct_options() */ - - int lasterr; - int lastsev; - - char uid[32]; - char pwd[32]; - - char server[64]; - char charset[64]; - char packetSize[64]; - char language[64]; - char ifile[255]; - char loginTimeout[64]; - char timeout[64]; - char scriptName[255]; - char hostname[255]; - char database[36]; - char curr_db[36]; - char tdsLevel[30]; - char encryptPassword[10]; - char kerberosPrincipal[256]; - char host[64]; /* for use with CS_SERVERADDR */ - char port[20]; /* for use with CS_SERVERADDR */ - char maxConnect[25]; - char sslCAFile[255]; - char blkLogin[16]; - char tds_keepalive[16]; - char serverType[32]; - - char serverVersion[15]; - char serverVersionString[255]; - - int isDead; - - SV *err_handler; - SV *row_cb; - SV *kerbGetTicket; - - int showEed; - int showSql; - int flushFinish; - int rowcount; - int doProcStatus; - int deadlockRetry; - int deadlockSleep; - int deadlockVerbose; - int nsqlNoStatus; - - int disconnectInChild; /* if set, then OK to disconnect in child process - (even if pid different from pid that created the connection), subject to the - setting of InactiveDestroy */ - - int noChildCon; /* Don't create child connections for - simultaneous statement handles */ - int failedDbUseFatal; - int bindEmptyStringNull; - int alwaysForceFailure; /* PR/471 */ - - int inUse; /* Set when the primary statement handle - (the one that uses the connection referred - to here) is in use. */ - int pid; /* Set when the connection is opened, used checked in the DESTROY() call */ - int init_done; + dbih_dbc_t com; /* MUST be first element in structure */ - char *sql; + CS_CONNECTION *connection; + CS_LOCALE *locale; + CS_IODESC iodesc; + char tranName[32]; + int inTransaction; + int doRealTran; + int chainedSupported; + int quotedIdentifier; + int useBin0x; + int binaryImage; + int dateFmt; /* 0 for Sybase native, 1 for ISO8601 */ + int optSupported; /* 0 if the server doesn't support ct_options() */ + + int lasterr; + int lastsev; + + char uid[32]; + char pwd[32]; + + char server[64]; + char charset[64]; + char packetSize[64]; + char language[64]; + char ifile[255]; + char loginTimeout[64]; + char timeout[64]; + char scriptName[255]; + char hostname[255]; + char database[36]; + char curr_db[36]; + char tdsLevel[30]; + char encryptPassword[10]; + char kerberosPrincipal[256]; + char host[64]; /* for use with CS_SERVERADDR */ + char port[20]; /* for use with CS_SERVERADDR */ + char maxConnect[25]; + char sslCAFile[255]; + char blkLogin[16]; + char tds_keepalive[16]; + char serverType[32]; + + char serverVersion[15]; + char serverVersionString[255]; + + int isDead; + + SV *err_handler; + SV *row_cb; + SV *kerbGetTicket; + + int enable_utf8; + + int showEed; + int showSql; + int flushFinish; + int rowcount; + int doProcStatus; + int deadlockRetry; + int deadlockSleep; + int deadlockVerbose; + int nsqlNoStatus; + + int disconnectInChild; /* if set, then OK to disconnect in child process + (even if pid different from pid that created the connection), subject to the + setting of InactiveDestroy */ + + int noChildCon; /* Don't create child connections for + simultaneous statement handles */ + int failedDbUseFatal; + int bindEmptyStringNull; + int alwaysForceFailure; /* PR/471 */ + + int inUse; /* Set when the primary statement handle + (the one that uses the connection referred + to here) is in use. */ + int pid; /* Set when the connection is opened, used checked in the DESTROY() call */ + int init_done; - struct imp_sth_st *imp_sth; /* needed for BCP handling */ + char *sql; + + struct imp_sth_st *imp_sth; /* needed for BCP handling */ }; typedef struct phs_st { - int ftype; - int sql_type; - SV *sv; - int sv_type; - bool is_inout; - IV maxlen; - - char *sv_buf; - - CS_DATAFMT datafmt; - char varname[34]; - - int alen_incnull; /* 0 or 1 if alen should include null */ - char name[1]; /* struct is malloc'd bigger as needed */ + int ftype; + int sql_type; + SV *sv; + int sv_type; + bool is_inout; + bool is_boundinout; + IV maxlen; + + char *sv_buf; + + CS_DATAFMT datafmt; + char varname[34]; + + int alen_incnull; /* 0 or 1 if alen should include null */ + char name[1]; /* struct is malloc'd bigger as needed */ } phs_t; +/* struct to store pointer to output parameter and returned length */ +typedef struct boundparams_st { + phs_t *phs; + int len; +} boundparams_t; + /* Define sth implementor data structure */ struct imp_sth_st { - dbih_stc_t com; /* MUST be first element in structure */ + dbih_stc_t com; /* MUST be first element in structure */ - CS_CONNECTION *connection; /* set if this is a sub-connection */ - CS_COMMAND *cmd; - ColData *coldata; - CS_DATAFMT *datafmt; - - int numCols; - CS_INT lastResType; - CS_INT numRows; - int moreResults; - - int doProcStatus; - int lastProcStatus; - int noBindBlob; - - int retryCount; - - int exec_done; - - /* Input Details */ - char dyn_id[50]; /* The id for this ct_dynamic() call */ - int dyn_execed; /* true if ct_dynamic(CS_EXECUTE) has been called */ - int type; /* 0 = normal, 1 => rpc */ - char proc[150]; /* used for rpc calls */ - char *statement; /* sql (see sth_scan) */ - HV *all_params_hv; /* all params, keyed by name */ - AV *out_params_av; /* quick access to inout params */ - int syb_pad_empty; /* convert ""->" " when binding */ - - /* Select Column Output Details */ - int done_desc; /* have we described this sth yet ? */ - - /* BCP functionality */ - int bcpFlag; - int bcpIdentityFlag; - int bcpIdentityCol; - CS_BLKDESC *bcp_desc; - int bcpRows; /* incremented for each successful call to blk_rowxfer, set to -1 when blk_done(CS_BLK_CANCEL) has been called. */ - int bcpAutoCommit; + CS_CONNECTION *connection; /* set if this is a sub-connection */ + CS_COMMAND *cmd; + ColData *coldata; + CS_DATAFMT *datafmt; + + int numCols; + CS_INT lastResType; + CS_INT numRows; + int moreResults; + + int doProcStatus; + int lastProcStatus; + int noBindBlob; + + int retryCount; + + int exec_done; + + /* Input Details */ + char dyn_id[50]; /* The id for this ct_dynamic() call */ + int dyn_execed; /* true if ct_dynamic(CS_EXECUTE) has been called */ + int type; /* 0 = normal, 1 => rpc */ + char proc[150]; /* used for rpc calls */ + char *statement; /* sql (see sth_scan) */ + HV *all_params_hv; /* all params, keyed by name */ + AV *out_params_av; /* quick access to inout params */ + int syb_pad_empty; /* convert ""->" " when binding */ + + /* Select Column Output Details */ + int done_desc; /* have we described this sth yet ? */ + + /* BCP functionality */ + int bcpFlag; + int bcpIdentityFlag; + int bcpIdentityCol; + CS_BLKDESC *bcp_desc; + int bcpRows; /* incremented for each successful call to blk_rowxfer, set to -1 when blk_done(CS_BLK_CANCEL) has been called. */ + int bcpAutoCommit; - /* (In/)Out Parameter Details */ - int has_inout_params; + /* (In/)Out Parameter Details */ + int has_inout_params; }; #define IMP_STH_EXECUTING 0x0001 diff -Nru libdbd-sybase-perl-1.09/debian/changelog libdbd-sybase-perl-1.14/debian/changelog --- libdbd-sybase-perl-1.09/debian/changelog 2011-11-19 12:00:57.000000000 +0000 +++ libdbd-sybase-perl-1.14/debian/changelog 2011-11-19 12:00:57.000000000 +0000 @@ -1,8 +1,9 @@ -libdbd-sybase-perl (1.09-3build1) precise; urgency=low +libdbd-sybase-perl (1.14-1) unstable; urgency=low - * Rebuild for Perl 5.14. + * New upstream release. + - Fix build failure with perl 5.14. Closes: #629255. - -- Colin Watson Tue, 15 Nov 2011 23:16:09 +0000 + -- Steve Langasek Fri, 18 Nov 2011 09:28:37 -0800 libdbd-sybase-perl (1.09-3) unstable; urgency=low diff -Nru libdbd-sybase-perl-1.09/Makefile.PL libdbd-sybase-perl-1.14/Makefile.PL --- libdbd-sybase-perl-1.09/Makefile.PL 2011-11-19 12:00:57.000000000 +0000 +++ libdbd-sybase-perl-1.14/Makefile.PL 2011-11-19 12:00:57.000000000 +0000 @@ -1,4 +1,4 @@ -# $Id: Makefile.PL,v 1.45 2007/04/10 15:42:21 mpeppler Exp $ +# $Id: Makefile.PL,v 1.47 2010/11/06 14:28:11 mpeppler Exp $ use ExtUtils::MakeMaker; @@ -14,410 +14,457 @@ use Getopt::Long; use vars qw($SYBASE $inc_string $lib_string $LINKTYPE $written_pwd_file - $newlibnames); + $newlibnames $libdir); -$LINKTYPE = 'dynamic'; +$LINKTYPE = 'dynamic'; $written_pwd_file = 'PWD'; +$libdir = 'lib'; my $file; my $chained; my $threaded_libs; my $accept_test_defaults; -GetOptions('--file' => \$file, '--chained:s' => \$chained, - '--threaded_libs:s' => \$threaded_libs, - '--accept_test_defaults' => \$accept_test_defaults); +GetOptions( + '--file' => \$file, + '--chained:s' => \$chained, + '--threaded_libs:s' => \$threaded_libs, + '--accept_test_defaults' => \$accept_test_defaults +); -select(STDOUT); $| = 1; +select(STDOUT); +$| = 1; configure(); configPwd(); my $lddlflags = $Config{lddlflags}; -$lddlflags = "-L$SYBASE/lib $lddlflags" unless $^O eq 'VMS'; +$lddlflags = "-L$SYBASE/$libdir $lddlflags" unless $^O eq 'VMS'; my $ldflags = $Config{ldflags}; -$ldflags = "-L$SYBASE/lib $ldflags" unless $^O eq 'VMS'; +$ldflags = "-L$SYBASE/$libdir $ldflags" unless $^O eq 'VMS'; - -WriteMakefile('NAME' => 'DBD::Sybase', - LIBS => [$lib_string], - INC => $inc_string, - clean => { FILES=> "Sybase.xsi $written_pwd_file" }, - OBJECT => '$(O_FILES)', - 'VERSION_FROM' => 'Sybase.pm', - 'LDDLFLAGS' => $lddlflags, -# 'LDFLAGS' => $ldflags, - LINKTYPE => $LINKTYPE, - ($^O eq 'VMS' ? - (MAN3PODS => { 'Sybase.pm' => 'blib/man3/DBD_Sybase.3' }) : - (MAN3PODS => { 'Sybase.pm' => 'blib/man3/DBD::Sybase.3pm' })), - ($] >= 5.005 ? - (ABSTRACT => 'DBI driver for Sybase datasources', - AUTHOR => 'Michael Peppler (mpeppler@peppler.org)') : ()), - ($] >= 5.005 && $^O eq 'MSWin32' && - $Config{archname} =~ /-object\b/i ? (CAPI => 'TRUE') :()), - 'dist' => {'TARFLAGS' => 'cvf', 'COMPRESS' => 'gzip'}, - ($^O eq 'VMS' ? (PM => 'Sybase.pm') :()) - ); +WriteMakefile( + 'NAME' => 'DBD::Sybase', + LIBS => [$lib_string], + INC => $inc_string, + clean => { FILES => "Sybase.xsi $written_pwd_file" }, + OBJECT => '$(O_FILES)', + 'VERSION_FROM' => 'Sybase.pm', + 'LDDLFLAGS' => $lddlflags, + + # 'LDFLAGS' => $ldflags, + LINKTYPE => $LINKTYPE, + ( + $^O eq 'VMS' + ? ( MAN3PODS => { 'Sybase.pm' => 'blib/man3/DBD_Sybase.3' } ) + : ( MAN3PODS => { 'Sybase.pm' => 'blib/man3/DBD::Sybase.3pm' } ) + ), + ( + $] >= 5.005 + ? ( + ABSTRACT => 'DBI driver for Sybase datasources', + AUTHOR => 'Michael Peppler (mpeppler@peppler.org)' + ) + : () + ), + ( + $] >= 5.005 + && $^O eq 'MSWin32' + && $Config{archname} =~ /-object\b/i ? ( CAPI => 'TRUE' ) : () + ), + 'dist' => { 'TARFLAGS' => 'cvf', 'COMPRESS' => 'gzip' }, + ( $^O eq 'VMS' ? ( PM => 'Sybase.pm' ) : () ) +); sub MY::postamble { - return dbd_postamble(); + return dbd_postamble(); } - sub configure { - my %attr; - my ($key, $val); + my %attr; + my ( $key, $val ); + + my $sybase_dir = $ENV{SYBASE}; - my $sybase_dir = $ENV{SYBASE}; + if ( !$sybase_dir ) { - if(!$sybase_dir) { - # PR 517 - getpwnam() isn't portable. - eval q{ + # PR 517 - getpwnam() isn't portable. + eval q{ $sybase_dir = (getpwnam('sybase'))[7]; }; - } + } + + open( IN, "CONFIG" ) || die "Can't open CONFIG: $!"; + while () { + chomp; + next if /^\s*\#/; + next if /^\s*$/; + + ( $key, $val ) = split( /\s*=\s*/, $_ ); + $key =~ s/\s//g; + $val =~ s/\s*$//; + + $attr{$key} = $val; + } + + if ( -d $sybase_dir ) { + $SYBASE = $sybase_dir; + } + else { + if ( $attr{SYBASE} && -d $attr{SYBASE} ) { + $SYBASE = $attr{SYBASE}; + } + } + + if ( !$SYBASE || $SYBASE =~ /^\s*$/ ) { + die +"Please set SYBASE in CONFIG, or set the \$SYBASE environment variable"; + } + + $SYBASE = VMS::Filespec::unixify($SYBASE) if $^O eq 'VMS'; + if ( $^O eq 'darwin' ) { + my $osxdir = 'Applications/Sybase/System'; + $SYBASE = $osxdir if -d $SYBASE && -d $osxdir; + } + + # System 12.0 has a different directory structure... + if ( defined( $ENV{SYBASE_OCS} ) ) { + $SYBASE .= "/$ENV{SYBASE_OCS}"; + } + + my $libsub = ''; + foreach $libdir ( 'lib', 'lib64' ) { + if ( -d "$SYBASE/$libdir" ) { + if ( checkLib($SYBASE) ) { + $libsub = $libdir; + } + } + } + + my $inc_found = 0; + if ( -d "$SYBASE/include" && -f "$SYBASE/include/cspublic.h" ) { + ++$inc_found; + $inc_string = "-I$SYBASE/include"; + } + + # In some freetds installations the include files have been moved + # into /usr/include/freetds. + if ( -d "$SYBASE/include/freetds" && "$SYBASE/include/freetds/cspublic.h" ) + { + ++$inc_found; + $inc_string = "-I$SYBASE/include/freetds"; + } + die "Can't find the Client Library include files under $SYBASE" + unless ($inc_found); + + my $version = getLibVersion("$SYBASE/$libsub"); + + # if(!$version || $version lt '12') { + #print "FreeTDS or older Client Library. Enabling CS-Lib Callbacks\n"; + #$inc_string .= " -DUSE_CSLIB_CB=1"; + # } - open(IN, "CONFIG") || die "Can't open CONFIG: $!"; - while() { - chomp; - next if /^\s*\#/; - next if /^\s*$/; - - ($key, $val) = split(/\s*=\s*/, $_); - $key =~ s/\s//g; - $val =~ s/\s*$//; - - $attr{$key} = $val; - } - - if(-d $sybase_dir) { - $SYBASE = $sybase_dir; - } else { - if($attr{SYBASE} && -d $attr{SYBASE}) { - $SYBASE = $attr{SYBASE}; - } - } - - if(!$SYBASE || $SYBASE =~ /^\s*$/) { - die "Please set SYBASE in CONFIG, or set the \$SYBASE environment variable"; - } - - $SYBASE = VMS::Filespec::unixify($SYBASE) if $^O eq 'VMS'; - if($^O eq 'darwin') { - my $osxdir = 'Applications/Sybase/System'; - $SYBASE = $osxdir if -d $SYBASE && -d $osxdir; - } - - # System 12.0 has a different directory structure... - if(defined($ENV{SYBASE_OCS})) { - $SYBASE .= "/$ENV{SYBASE_OCS}"; - } - - if(! -d "$SYBASE/lib") { - die "Can't find the lib directory under $SYBASE!"; - } - - my $inc_found = 0; - if(-d "$SYBASE/include" && -f "$SYBASE/include/cspublic.h") { - ++$inc_found; - $inc_string = "-I$SYBASE/include"; - } - # In some freetds installations the include files have been moved - # into /usr/include/freetds. - if(-d "$SYBASE/include/freetds" && "$SYBASE/include/freetds/cspublic.h") { - ++$inc_found; - $inc_string = "-I$SYBASE/include/freetds"; - } - die "Can't find the Client Library include files under $SYBASE" unless($inc_found); - - my $version = getLibVersion($SYBASE); -# if(!$version || $version lt '12') { - #print "FreeTDS or older Client Library. Enabling CS-Lib Callbacks\n"; - #$inc_string .= " -DUSE_CSLIB_CB=1"; -# } - - checkChainedAutoCommit(); - -# print "OS = $^O\n"; - - if($^O eq 'MSWin32') { - $lib_string = "-L$SYBASE/lib -llibct.lib -llibcs.lib -llibtcl.lib -llibcomn.lib -llibintl.lib -llibblk.lib $attr{EXTRA_LIBS} -lm"; - } elsif($^O eq 'VMS') { - $lib_string = "-L$SYBASE/lib -llibct.olb -llibcs.olb -llibtcl.olb -llibcomn.olb -llibintl.olb -llibblk.olb $attr{EXTRA_LIBS}"; - } elsif($^O =~ /cygwin/) { - $lib_string = "-L$SYBASE/lib -lct -lcs -lblk"; - $inc_string .= " -D_MSC_VER=800"; - } else { - # Supplied by Erick Calder. I'm not sure why libsybsrv is needed... - $attr{EXTRA_LIBS} .= " -lsybsrv" if $^O eq 'darwin'; - - my $extra = getExtraLibs($SYBASE, $attr{EXTRA_LIBS}, $version); - if($file) { - $lib_string = "-L$SYBASE/lib -lct -lcs -ltcl -lcomn -lintl -lblk $attr{EXTRA_LIBS} -ldl -lm"; - } else { - $lib_string = "-L$SYBASE/lib -lct -lcs -ltcl -lcomn -lintl -lblk $extra -ldl -lm"; - } - if($newlibnames) { - foreach (qw(ct cs tcl comn intl blk)) { - $lib_string =~ s/-l$_/-lsyb$_/; - } - } elsif($^O =~ /linux|freebsd/i) { - $lib_string =~ s/-ltcl/-lsybtcl/; - } - - my %libname; - - %libname = loadSybLibs("$SYBASE/lib"); - - my $libtype = ''; - - # Logic to replace normal libs with _r (re-entrant) libs if - # usethreads is defined provided by W. Phillip Moore (wpm@ms.com) - # I have no idea if this works on Win32 systems (probably not!) - if ( $Config{usethreads} ) { - print "Running in threaded mode - looking for _r libraries...\n"; - - if(checkForThreadedLibs()) { - my $found = 0; - foreach ( split(/\s+/,$lib_string) ) { - next unless /^-l(\S+)/; - my $oldname = $1; - my $newname = $1 . "_r"; - next unless exists $libname{$newname}; - print "Found -l$newname for -l$oldname\n"; - ++$found; - $lib_string =~ s/-l$oldname\b/-l$newname/; - } - if(!$found) { - print "No thread-safe Sybase libraries found\n"; - $inc_string .= ' -DNO_THREADS '; - } else { - $libtype .= '_r'; - } - } else { - print "OK - I'll use the normal libs\n\n"; - } - } - - # If we are building for a 64 bit platform that also supports 32 bit - # (i.e. Solaris 8, HP-UX11, etc) then we need to make some adjustments - if( $Config{use64bitall} ) { - # Tru64/DEC OSF does NOT use the SYB_LP64 define - # as it is ALWAYS in 64 bit mode. - $inc_string .= ' -DSYB_LP64' unless $^O eq 'dec_osf'; - - print "Running in 64bit mode - looking for '64' libraries...\n"; - - my $found = 0; - foreach ( split(/\s+/,$lib_string) ) { - next unless /^-l(\S+)/; - my $oldname = $1; - my $newname = $1 . '64'; - next unless exists $libname{$newname}; - print "Found -l$newname for -l$oldname\n"; - $lib_string =~ s/-l$oldname\b/-l$newname/; - ++$found; - } - if($found) { - $libtype .= '64'; - } - } - - # Is the blk library available? - #my @k = keys(%libname); - #print "@k\n"; - #print "libtype = $libtype\n"; - if(my @l = grep(/(syb)?blk$libtype/, keys(%libname))) { - print "BLK api available - found: @l\n"; - } else { - print "BLK api NOT available.\n"; - $inc_string .= ' -DNO_BLK=1' - } - } - - my $config_sitearch = $Config{sitearchexp}; - my $attr_dbi_include = $attr{DBI_INCLUDE}; - if ($^O eq 'VMS') { - $config_sitearch = VMS::Filespec::unixify($config_sitearch); - $attr_dbi_include = VMS::Filespec::unixify($attr_dbi_include); - } - my @try = (@INC, $Config{sitearchexp}); - unshift @try, $attr{DBI_INCLUDE} if $attr{DBI_INCLUDE}; - my $dbidir; - for my $trydir (@try) { - if (-e "$trydir/auto/DBI/DBIXS.h") { - $dbidir = "$trydir/auto/DBI"; - last; - } - } - die "Can't find the DBI include files. Please set DBI_INCLUDE in CONFIG" - if !$dbidir; - $inc_string .= " -I$dbidir"; - if($attr{LINKTYPE}) { - $LINKTYPE = $attr{LINKTYPE} - } + checkChainedAutoCommit(); + + # print "OS = $^O\n"; + + if ( $^O eq 'MSWin32' ) { + $lib_string = +"-L$SYBASE/lib -llibct.lib -llibcs.lib -llibtcl.lib -llibcomn.lib -llibintl.lib -llibblk.lib $attr{EXTRA_LIBS} -lm"; + } + elsif ( $^O eq 'VMS' ) { + $lib_string = +"-L$SYBASE/lib -llibct.olb -llibcs.olb -llibtcl.olb -llibcomn.olb -llibintl.olb -llibblk.olb $attr{EXTRA_LIBS}"; + } + elsif ( $^O =~ /cygwin/ ) { + $lib_string = "-L$SYBASE/lib -lct -lcs -lblk"; + $inc_string .= " -D_MSC_VER=800"; + } + else { + + # Supplied by Erick Calder. I'm not sure why libsybsrv is needed... + $attr{EXTRA_LIBS} .= " -lsybsrv" if $^O eq 'darwin'; + + my $extra = getExtraLibs( $SYBASE, $attr{EXTRA_LIBS}, $version ); + if ($file) { + $lib_string = +"-L$SYBASE/$libdir -lct -lcs -ltcl -lcomn -lintl -lblk $attr{EXTRA_LIBS} -ldl -lm"; + } + else { + $lib_string = +"-L$SYBASE/$libdir -lct -lcs -ltcl -lcomn -lintl -lblk $extra -ldl -lm"; + } + if ($newlibnames) { + foreach (qw(ct cs tcl comn intl blk)) { + $lib_string =~ s/-l$_/-lsyb$_/; + } + } + elsif ( $^O =~ /linux|freebsd/i ) { + $lib_string =~ s/-ltcl/-lsybtcl/; + } + + my %libname; + + %libname = loadSybLibs("$SYBASE/$libdir"); + + my $libtype = ''; + + # Logic to replace normal libs with _r (re-entrant) libs if + # usethreads is defined provided by W. Phillip Moore (wpm@ms.com) + # I have no idea if this works on Win32 systems (probably not!) + if ( $Config{usethreads} ) { + print "Running in threaded mode - looking for _r libraries...\n"; + + if ( checkForThreadedLibs() ) { + my $found = 0; + foreach ( split( /\s+/, $lib_string ) ) { + next unless /^-l(\S+)/; + my $oldname = $1; + my $newname = $1 . "_r"; + next unless exists $libname{$newname}; + print "Found -l$newname for -l$oldname\n"; + ++$found; + $lib_string =~ s/-l$oldname\b/-l$newname/; + } + if ( !$found ) { + print "No thread-safe Sybase libraries found\n"; + $inc_string .= ' -DNO_THREADS '; + } + else { + $libtype .= '_r'; + } + } + else { + print "OK - I'll use the normal libs\n\n"; + } + } + + # If we are building for a 64 bit platform that also supports 32 bit + # (i.e. Solaris 8, HP-UX11, etc) then we need to make some adjustments + if ( $Config{use64bitall} ) { + + # Tru64/DEC OSF does NOT use the SYB_LP64 define + # as it is ALWAYS in 64 bit mode. + $inc_string .= ' -DSYB_LP64' unless $^O eq 'dec_osf'; + + print "Running in 64bit mode - looking for '64' libraries...\n"; + + my $found = 0; + foreach ( split( /\s+/, $lib_string ) ) { + next unless /^-l(\S+)/; + my $oldname = $1; + my $newname = $1 . '64'; + next unless exists $libname{$newname}; + print "Found -l$newname for -l$oldname\n"; + $lib_string =~ s/-l$oldname\b/-l$newname/; + ++$found; + } + if ($found) { + $libtype .= '64'; + } + } + + # Is the blk library available? + #my @k = keys(%libname); + #print "@k\n"; + #print "libtype = $libtype\n"; + if ( my @l = grep( /(syb)?blk$libtype/, keys(%libname) ) ) { + print "BLK api available - found: @l\n"; + } + else { + print "BLK api NOT available.\n"; + $inc_string .= ' -DNO_BLK=1'; + } + } + + my $config_sitearch = $Config{sitearchexp}; + my $attr_dbi_include = $attr{DBI_INCLUDE}; + if ( $^O eq 'VMS' ) { + $config_sitearch = VMS::Filespec::unixify($config_sitearch); + $attr_dbi_include = VMS::Filespec::unixify($attr_dbi_include); + } + my @try = ( @INC, $Config{sitearchexp} ); + unshift @try, $attr{DBI_INCLUDE} if $attr{DBI_INCLUDE}; + my $dbidir; + for my $trydir (@try) { + if ( -e "$trydir/auto/DBI/DBIXS.h" ) { + $dbidir = "$trydir/auto/DBI"; + last; + } + } + die "Can't find the DBI include files. Please set DBI_INCLUDE in CONFIG" + if !$dbidir; + $inc_string .= " -I$dbidir"; + if ( $attr{LINKTYPE} ) { + $LINKTYPE = $attr{LINKTYPE}; + } } sub loadSybLibs { - my $dir = shift; + my $dir = shift; - my %libname = (); - - opendir(SYBLIB, $dir) - or die "Unable to opendir $dir: $!\n"; - foreach ( readdir(SYBLIB) ) { - next unless -f "$dir/$_"; - next unless /^lib(\S+)\.(so|a|sl)/; - $libname{$1} = 1; - } - - closedir(SYBLIB); + my %libname = (); - return %libname; + opendir( SYBLIB, $dir ) + or die "Unable to opendir $dir: $!\n"; + foreach ( readdir(SYBLIB) ) { + next unless -f "$dir/$_"; + next unless /^lib(\S+)\.(so|a|sl)/; + $libname{$1} = 1; + } + + closedir(SYBLIB); + + return %libname; } sub getLibVersion { - my $dir = shift; + my $lib = shift; + + opendir( DIR, $lib ); - my $lib = "$dir/lib"; - opendir(DIR, $lib); - # reverse to pick up libsybct before libct... - my @files = reverse(grep(/lib(syb)?ct(64)?\./, readdir(DIR))); - closedir(DIR); - my $file; - foreach (@files) { - $file = "$lib/$_"; - last if -e $file; - } - - my $version; - - if (open(IN, $file)) { - binmode(IN); - while() { - if(/Sybase Client-Library\/([^\/]+)\//) { - $version = $1; - last; - } - } - close(IN); - } - if(!$version) { - print "Unknown Client Library version - assuming FreeTDS.\n"; - } else { - print "Sybase OpenClient $version found.\n"; - } + # reverse to pick up libsybct before libct... + my @files = reverse( grep( /lib(syb)?ct(64)?\./, readdir(DIR) ) ); + closedir(DIR); + my $file; + foreach (@files) { + $file = "$lib/$_"; + last if -e $file; + } + + my $version; + if (open(IN, $file)) { + binmode(IN); + while() { + if(/Sybase Client-Library\/([^\/]+)\//) { + $version = $1; + last; + } + } + close(IN); + } + if ( !$version ) { + print "Unknown Client Library version - assuming FreeTDS.\n"; + } + else { + print "Sybase OpenClient $version found.\n"; + } - return $version; + return $version; } sub getExtraLibs { - my $dir = shift; - my $cfg = shift; - my $version = shift; - - opendir(DIR, "$dir/lib") || die "Can't access $dir/lib: $!"; - my %files = map { $_ =~ s/lib([^\.]+)\..*/$1/; $_ => 1 } grep(/lib/ && -f "$dir/lib/$_", readdir(DIR)); - closedir(DIR); - - my %x = map {$_ => 1} split(' ', $cfg); - my $dlext = $Config{dlext} || 'so'; - foreach my $f (keys(%x)) { - my $file = $f; - $file =~ s/-l//; - next if($file =~ /^-/); - delete($x{$f}) unless exists($files{$file}); - } - - foreach my $f (qw(insck tli sdna dnet_stub tds skrb gss)) { - $x{"-l$f"} = 1 if exists $files{$f} && -f "$dir/lib/lib$f.$dlext"; - } - if($version gt '11') { - delete($x{-linsck}); - delete($x{-ltli}); - } -# if($version ge '12.5.1') { -# delete($x{-lskrb}); -# } + my $dir = shift; + my $cfg = shift; + my $version = shift; + + opendir( DIR, "$dir/$libdir" ) || die "Can't access $dir/$libdir: $!"; + my %files = + map { $_ =~ s/lib([^\.]+)\..*/$1/; $_ => 1 } + grep( /lib/ && -f "$dir/$libdir/$_", readdir(DIR) ); + closedir(DIR); + + my %x = map { $_ => 1 } split( ' ', $cfg ); + my $dlext = $Config{dlext} || 'so'; + foreach my $f ( keys(%x) ) { + my $file = $f; + $file =~ s/-l//; + next if ( $file =~ /^-/ ); + delete( $x{$f} ) unless exists( $files{$file} ); + } + + foreach my $f (qw(insck tli sdna dnet_stub tds skrb gss)) { + $x{"-l$f"} = 1 if exists $files{$f} && -f "$dir/$libdir/lib$f.$dlext"; + } + if ( $version gt '11' ) { + delete( $x{-linsck} ); + delete( $x{-ltli} ); + } + + # if($version ge '12.5.1') { + # delete($x{-lskrb}); + # } - join(' ', keys(%x)); + join( ' ', keys(%x) ); } - - + sub checkLib { - my $dir = shift; + my $dir = shift; - opendir(DIR, "$dir/lib") || die "Can't access $dir/lib: $!"; - my @files = grep(/libct|libsybct/i, readdir(DIR)); - closedir(DIR); - if(grep(/libsybct/, @files)) { - $newlibnames = 1; - } else { - $newlibnames = 0; - } + opendir( DIR, "$dir/$libdir" ) || die "Can't access $dir/$libdir: $!"; + my @files = grep( /libct|libsybct/i, readdir(DIR) ); + closedir(DIR); + if ( grep( /libsybct/, @files ) ) { + $newlibnames = 1; + } + else { + $newlibnames = 0; + } - scalar(@files); + scalar(@files); } sub configPwd { - open(IN, "PWD.factory") || die "Can't open PWD.factory: $!"; - my %pwd; - while() { - chomp; - next if(/^\s*\#/); - next if(/^\s*$/); - my ($key, $val) = split(/=/, $_); - $pwd{$key} = $val || "undef"; - } - close(IN); - - if($accept_test_defaults) { - $pwd{SRV} = $pwd{SRV}; - $pwd{UID} = $pwd{UID}; - $pwd{PWD} = $pwd{PWD}; - $pwd{DB} = $pwd{DB}; - } else { - print "The DBD::Sybase module need access to a Sybase server to run the tests.\n"; - print "To clear an entry please enter 'undef'\n"; - print "Sybase server to use (default: $pwd{SRV}): "; - $pwd{SRV} = getAns(0) || $pwd{SRV}; - print "User ID to log in to Sybase (default: $pwd{UID}): "; - $pwd{UID} = getAns(0) || $pwd{UID}; - print "Password (default: $pwd{PWD}): "; - $pwd{PWD} = getAns(1) || $pwd{PWD}; - print "Sybase database to use on $pwd{SRV} (default: $pwd{DB}): "; - $pwd{DB} = getAns(0) || $pwd{DB}; - } - - warn "\n* Writing login information, including password, to file $written_pwd_file.\n\n"; - - # Create the file non-readable by anyone else. - my $old_umask; - unless($^O =~ /MSWin32/) { - $old_umask = umask(077); - warn "cannot umask(): $!" unless defined($old_umask); - } - open(OUT, ">$written_pwd_file") || die "Can't open $written_pwd_file: $!"; - unless($^O =~ /MSWin32/) { - umask($old_umask) != 077 && warn "strange return from umask()"; - } - print OUT <) { + chomp; + next if (/^\s*\#/); + next if (/^\s*$/); + my ( $key, $val ) = split( /=/, $_ ); + $pwd{$key} = $val || "undef"; + } + close(IN); + + if ($accept_test_defaults) { + $pwd{SRV} = $pwd{SRV}; + $pwd{UID} = $pwd{UID}; + $pwd{PWD} = $pwd{PWD}; + $pwd{DB} = $pwd{DB}; + } + else { + print +"The DBD::Sybase module need access to a Sybase server to run the tests.\n"; + print "To clear an entry please enter 'undef'\n"; + print "Sybase server to use (default: $pwd{SRV}): "; + $pwd{SRV} = getAns(0) || $pwd{SRV}; + print "User ID to log in to Sybase (default: $pwd{UID}): "; + $pwd{UID} = getAns(0) || $pwd{UID}; + print "Password (default: $pwd{PWD}): "; + $pwd{PWD} = getAns(1) || $pwd{PWD}; + print "Sybase database to use on $pwd{SRV} (default: $pwd{DB}): "; + $pwd{DB} = getAns(0) || $pwd{DB}; + } + + warn +"\n* Writing login information, including password, to file $written_pwd_file.\n\n"; + + # Create the file non-readable by anyone else. + my $old_umask; + unless ( $^O =~ /MSWin32/ ) { + $old_umask = umask(077); + warn "cannot umask(): $!" unless defined($old_umask); + } + open( OUT, ">$written_pwd_file" ) || die "Can't open $written_pwd_file: $!"; + unless ( $^O =~ /MSWin32/ ) { + umask($old_umask) != 077 && warn "strange return from umask()"; + } + print OUT <= 5.008) { - $ret = 0; + my $ret = 1; + if ( $] >= 5.008 ) { + $ret = 0; - print <; - if($flag && -t) { - eval { - Term::ReadKey::ReadMode('normal'); - }; - print "\n"; # because newline from user wasn't echo'd - } - $ans =~ s/^\s+//; - $ans =~ s/\s+$//; + if ( $flag && -t ) { + eval { + require Term::ReadKey; + Term::ReadKey::ReadMode('noecho'); + }; + } + my $ans = ; + if ( $flag && -t ) { + eval { Term::ReadKey::ReadMode('normal'); }; + print "\n"; # because newline from user wasn't echo'd + } + $ans =~ s/^\s+//; + $ans =~ s/\s+$//; - return $ans; + return $ans; } diff -Nru libdbd-sybase-perl-1.09/MANIFEST libdbd-sybase-perl-1.14/MANIFEST --- libdbd-sybase-perl-1.09/MANIFEST 2004-11-26 09:48:06.000000000 +0000 +++ libdbd-sybase-perl-1.14/MANIFEST 2011-04-25 09:00:44.000000000 +0000 @@ -23,6 +23,7 @@ t/exec.t t/nsql.t t/thread.t +t/utf8.t t/xblob.t t/xblk.t t/screen.jpg diff -Nru libdbd-sybase-perl-1.09/META.yml libdbd-sybase-perl-1.14/META.yml --- libdbd-sybase-perl-1.09/META.yml 2008-08-31 12:13:08.000000000 +0000 +++ libdbd-sybase-perl-1.14/META.yml 2011-10-02 15:04:27.000000000 +0000 @@ -1,10 +1,10 @@ # http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: DBD-Sybase -version: 1.09 +version: 1.14 version_from: Sybase.pm installdirs: site requires: distribution_type: module -generated_by: ExtUtils::MakeMaker version 6.30 +generated_by: ExtUtils::MakeMaker version 6.17 diff -Nru libdbd-sybase-perl-1.09/README libdbd-sybase-perl-1.14/README --- libdbd-sybase-perl-1.09/README 2007-04-10 15:43:25.000000000 +0000 +++ libdbd-sybase-perl-1.14/README 2011-04-25 09:00:44.000000000 +0000 @@ -1,8 +1,8 @@ -$Id: README,v 1.26 2007/04/10 15:43:25 mpeppler Exp $ +$Id: README,v 1.27 2011/04/25 08:59:17 mpeppler Exp $ DBD::Sybase -- a Sybase DBI driver for Perl 5. - Copyright (c) 1996-2007 Michael Peppler + Copyright (c) 1996-2011 Michael Peppler You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. diff -Nru libdbd-sybase-perl-1.09/Sybase.h libdbd-sybase-perl-1.14/Sybase.h --- libdbd-sybase-perl-1.09/Sybase.h 2007-04-11 17:27:29.000000000 +0000 +++ libdbd-sybase-perl-1.14/Sybase.h 2011-10-02 14:56:17.000000000 +0000 @@ -1,6 +1,6 @@ -/* $Id: Sybase.h,v 1.14 2007/04/11 17:27:29 mpeppler Exp $ +/* $Id: Sybase.h,v 1.21 2011/10/02 14:53:49 mpeppler Exp $ - Copyright (c) 1997 - 2007 Michael Peppler + Copyright (c) 1997 - 2011 Michael Peppler You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. @@ -49,6 +49,18 @@ #include "dbdimp.h" +#if defined(CS_CURRENT_VERSION) +#define CTLIB_VERSION CS_CURRENT_VERSION +#else +#if defined(CS_VERSION_157) +#define CTLIB_VERSION CS_VERSION_157 +#else +#if defined(CS_VERSION_155) +#define CTLIB_VERSION CS_VERSION_155 +#else +#if defined(CS_VERSION_150) +#define CTLIB_VERSION CS_VERSION_150 +#else #if defined(CS_VERSION_125) #define CTLIB_VERSION CS_VERSION_125 #else @@ -62,6 +74,16 @@ #endif #endif #endif +#endif +#endif +#endif +#endif + +#if defined(CS_UNICHAR_TYPE) && defined(CS_VERSION_150) +#if defined (is_utf8_string) +#define DBD_CAN_HANDLE_UTF8 +#endif +#endif /*#define CTLIB_VERSION CS_VERSION_100 */ diff -Nru libdbd-sybase-perl-1.09/Sybase.pm libdbd-sybase-perl-1.14/Sybase.pm --- libdbd-sybase-perl-1.09/Sybase.pm 2008-08-31 08:46:22.000000000 +0000 +++ libdbd-sybase-perl-1.14/Sybase.pm 2011-10-02 14:56:17.000000000 +0000 @@ -1,7 +1,7 @@ # -*-Perl-*- -# $Id: Sybase.pm,v 1.106 2008/08/31 08:46:22 mpeppler Exp $ +# $Id: Sybase.pm,v 1.115 2011/10/02 14:55:38 mpeppler Exp $ -# Copyright (c) 1996-2008 Michael Peppler +# Copyright (c) 1996-2011 Michael Peppler # # You may distribute under the terms of either the GNU General Public # License or the Artistic License, as specified in the Perl README file. @@ -9,568 +9,653 @@ # Based on DBD::Oracle Copyright (c) 1994,1995,1996,1997 Tim Bunce { - package DBD::Sybase; - use DBI (); - use DynaLoader (); - use Exporter (); + package DBD::Sybase; - use Sys::Hostname (); - - @ISA = qw(DynaLoader Exporter); - - @EXPORT = qw(CS_ROW_RESULT CS_CURSOR_RESULT CS_PARAM_RESULT - CS_STATUS_RESULT CS_MSG_RESULT CS_COMPUTE_RESULT); + use DBI (); + use DynaLoader (); + use Exporter (); + + use Sys::Hostname (); + + @ISA = qw(DynaLoader Exporter); + + @EXPORT = qw(CS_ROW_RESULT CS_CURSOR_RESULT CS_PARAM_RESULT + CS_STATUS_RESULT CS_MSG_RESULT CS_COMPUTE_RESULT); + + $hostname = Sys::Hostname::hostname(); + $init_done = 0; + $VERSION = '1.14'; + my $Revision = substr( q$Revision: 1.115 $, 10 ); + + require_version DBI 1.30; + + # dl_open() calls need to use the RTLD_GLOBAL flag if + # you are going to use the Kerberos libraries. + # There are systems / OSes where this does not work (AIX 5.x, for example) + # set to 1 to get RTLD_GLOBAL turned on. + sub dl_load_flags { 0x00 } + + bootstrap DBD::Sybase $VERSION; + + $drh = undef; # holds driver handle once initialised + + sub driver { + return $drh if $drh; + my ( $class, $attr ) = @_; + $class .= "::dr"; + ($drh) = DBI::_new_drh( + $class, + { + 'Name' => 'Sybase', + 'Version' => $VERSION, + 'Attribution' => 'Sybase DBD by Michael Peppler', + } + ); + if ( $DBI::VERSION >= 1.37 && !$DBD::Sybase::init_done ) { + DBD::Sybase::db->install_method('syb_nsql'); + DBD::Sybase::db->install_method('syb_date_fmt'); + DBD::Sybase::db->install_method('syb_isdead'); + DBD::Sybase::st->install_method('syb_ct_get_data'); + DBD::Sybase::st->install_method('syb_ct_data_info'); + DBD::Sybase::st->install_method('syb_ct_send_data'); + DBD::Sybase::st->install_method('syb_ct_prepare_send'); + DBD::Sybase::st->install_method('syb_ct_finish_send'); + DBD::Sybase::st->install_method('syb_output_params'); + DBD::Sybase::st->install_method('syb_describe'); + ++$DBD::Sybase::init_done; + } - $hostname = Sys::Hostname::hostname(); - $init_done = 0; - $VERSION = '1.09'; - my $Revision = substr(q$Revision: 1.106 $, 10); + $drh; + } - require_version DBI 1.30; + sub CLONE { + undef $drh; + } - # dl_open() calls need to use the RTLD_GLOBAL flag if - # you are going to use the Kerberos libraries. - # There are systems / OSes where this does not work (AIX 5.x, for example) - # set to 1 to get RTLD_GLOBAL turned on. - sub dl_load_flags { 0x00 } + 1; +} - bootstrap DBD::Sybase $VERSION; +{ + package DBD::Sybase::dr; # ====== DRIVER ====== + use strict; - $drh = undef; # holds driver handle once initialised + sub connect { + my ( $drh, $dbase, $user, $auth, $attr ) = @_; + my $server = $dbase || $ENV{DSQUERY} || 'SYBASE'; + + my ($this) = DBI::_new_dbh( + $drh, + { + 'Name' => $server, + 'Username' => $user, + 'CURRENT_USER' => $user, + } + ); - sub driver { - return $drh if $drh; - my($class, $attr) = @_; - $class .= "::dr"; - ($drh) = DBI::_new_drh($class, { - 'Name' => 'Sybase', - 'Version' => $VERSION, - 'Attribution' => 'Sybase DBD by Michael Peppler', - }); + DBD::Sybase::db::_login( $this, $server, $user, $auth, $attr ) + or return undef; - if($DBI::VERSION >= 1.37 && !$DBD::Sybase::init_done) { - DBD::Sybase::db->install_method('syb_nsql'); - DBD::Sybase::db->install_method('syb_date_fmt'); - DBD::Sybase::st->install_method('syb_ct_get_data'); - DBD::Sybase::st->install_method('syb_ct_data_info'); - DBD::Sybase::st->install_method('syb_ct_send_data'); - DBD::Sybase::st->install_method('syb_ct_prepare_send'); - DBD::Sybase::st->install_method('syb_ct_finish_send'); - DBD::Sybase::st->install_method('syb_output_params'); - DBD::Sybase::st->install_method('syb_describe'); - ++$DBD::Sybase::init_done; + return $this; } - $drh; - } - - sub CLONE { - undef $drh; - } + sub data_sources { + my @s; + if ( $^O eq 'MSWin32' ) { + open( INTERFACES, "$ENV{SYBASE}/ini/sql.ini" ) or return; + @s = map { /\[(\S+)\]/i; "dbi:Sybase:server=$1" } grep /\[/i, + ; + close(INTERFACES); + } + else { + open( INTERFACES, "$ENV{SYBASE}/interfaces" ) or return; + @s = map { /^(\S+)/i; "dbi:Sybase:server=$1" } grep /^[^\s\#]/i, + ; + close(INTERFACES); + } - 1; + return @s; + } } +{ -{ package DBD::Sybase::dr; # ====== DRIVER ====== - use strict; + package DBD::Sybase::db; # ====== DATABASE ====== + use strict; - sub connect { - my($drh, $dbase, $user, $auth, $attr)= @_; - my $server = $dbase || $ENV{DSQUERY} || 'SYBASE'; + use DBI qw(:sql_types); + use Carp; + sub prepare { + my ( $dbh, $statement, @attribs ) = @_; - my($this) = DBI::_new_dbh($drh, { - 'Name' => $server, - 'Username' => $user, - 'CURRENT_USER' => $user, - }); + # create a 'blank' sth - DBD::Sybase::db::_login($this, $server, $user, $auth, $attr) - or return undef; + my $sth = DBI::_new_sth( $dbh, { 'Statement' => $statement, } ); - return $this; - } + DBD::Sybase::st::_prepare( $sth, $statement, @attribs ) + or return undef; - sub data_sources { - my @s; - if ($^O eq 'MSWin32') { - open(INTERFACES, "$ENV{SYBASE}/ini/sql.ini") or return; - @s = map { /\[(\S+)\]/i; "dbi:Sybase:server=$1" } grep /\[/i, ; - close(INTERFACES); - } else { - open(INTERFACES, "$ENV{SYBASE}/interfaces") or return; - @s = map { /^(\S+)/i; "dbi:Sybase:server=$1" } grep /^[^\s\#]/i, ; - close(INTERFACES); + $sth; } - return @s; - } -} - + sub tables { + my $dbh = shift; + my $catalog = shift; + my $schema = shift || '%'; + my $table = shift || '%'; + my $type = shift || '%'; + $type =~ s/[\'\"\s]//g; # strip quotes and spaces + if ( $type =~ /,/ ) { # multiple types + $type = '[' + . join( '', map { substr( $_, 0, 1 ) } split /,/, $type ) . ']'; + } + else { + $type = substr( $type, 0, 1 ); + } + $type =~ s/T/U/; -{ package DBD::Sybase::db; # ====== DATABASE ====== - use strict; + my $sth; + if ( $catalog and $catalog ne '%' ) { + $sth = + $dbh->prepare( +"select o.name from $catalog..sysobjects o, $catalog..sysusers u where o.type like '$type' and o.name like '$table' and o.uid = u.uid and u.name like '$schema'" + ); + } + else { + $sth = + $dbh->prepare( +"select o.name from sysobjects o, sysusers u where o.type like '$type' and o.name like '$table' and o.uid = u.uid and u.name like '$schema'" + ); + } - use DBI qw(:sql_types); - use Carp; - - sub prepare { - my($dbh, $statement, @attribs)= @_; + $sth->execute; + my @names; + my $dat; + while ( $dat = $sth->fetch ) { + push( @names, $dat->[0] ); + } + @names; + } - # create a 'blank' sth + # NOTE - RaiseError & PrintError is turned off while we are inside this + # function, so we must check for any error, and return immediately if + # any error is found. + # XXX add optional deadlock detection? + sub do { + my ( $dbh, $statement, $attr, @params ) = @_; + + my $sth = $dbh->prepare( $statement, $attr ) or return undef; + $sth->execute(@params) or return undef; + return undef if $sth->err; + if ( defined( $sth->{syb_more_results} ) ) { + { + while ( my $dat = $sth->fetch ) { + return undef if $sth->err; + + # XXX do something intelligent here... + } + redo if $sth->{syb_more_results}; + } + } + my $rows = $sth->rows; - my $sth = DBI::_new_sth($dbh, { - 'Statement' => $statement, - }); + ( $rows == 0 ) ? "0E0" : $rows; + } + # This will only work if the statement handle used to do the insert + # has been properly freed. Otherwise this will try to fetch @@identity + # from a different (new!) connection - which is obviously wrong. + sub last_insert_id { + my ( $dbh, $catalog, $schema, $table, $field, $attr ) = @_; - DBD::Sybase::st::_prepare($sth, $statement, @attribs) - or return undef; + # parameters are ignored. - $sth; - } + my $sth = $dbh->prepare('select @@identity'); + if ( !$sth->execute ) { + return undef; + } + my $value; + ($value) = $sth->fetchrow_array; + $sth->finish; + + return $value; + } + + sub table_info { + my $dbh = shift; + my $catalog = $dbh->quote(shift); + my $schema = $dbh->quote(shift); + my $table = $dbh->quote(shift); + my $type = $dbh->quote(shift); + + my $sth = $dbh->prepare("sp_tables $table, $schema, $catalog, $type"); + + # Another possibility would be: + # select TABLE_QUALIFIER = NULL + # , TABLE_OWNER = u.name + # , TABLE_NAME = o.name + # , TABLE_TYPE = o.type -- XXX + # , REMARKS = NULL + # from sysobjects o + # , sysusers u + # where o.type in ('U', 'V', 'S') + # and o.uid = u.uid - sub tables { - my $dbh = shift; - my $catalog = shift; - my $schema = shift || '%'; - my $table = shift || '%'; - my $type = shift || '%'; - $type =~ s/[\'\"\s]//g; # strip quotes and spaces - if ($type =~ /,/) { # multiple types - $type = '[' . join('', map { substr($_,0,1) } split /,/, $type) . ']'; - } else { - $type = substr($type,0,1); - } - $type =~ s/T/U/; - - my $sth; - if ($catalog and $catalog ne '%') { - $sth = $dbh->prepare("select o.name from $catalog..sysobjects o, $catalog..sysusers u where o.type like '$type' and o.name like '$table' and o.uid = u.uid and u.name like '$schema'"); - } else { - $sth = $dbh->prepare("select o.name from sysobjects o, sysusers u where o.type like '$type' and o.name like '$table' and o.uid = u.uid and u.name like '$schema'"); - } - - $sth->execute; - my @names; - my $dat; - while($dat = $sth->fetch) { - push(@names, $dat->[0]); + $sth->execute; + $sth; } - @names; - } -# NOTE - RaiseError & PrintError is turned off while we are inside this -# function, so we must check for any error, and return immediately if -# any error is found. -# XXX add optional deadlock detection? - sub do { - my($dbh, $statement, $attr, @params) = @_; - - my $sth = $dbh->prepare($statement, $attr) or return undef; - $sth->execute(@params) or return undef; - return undef if $sth->err; - if(defined($sth->{syb_more_results})) { - { - while(my $dat = $sth->fetch) { - return undef if $sth->err; - # XXX do something intelligent here... + { + + my $names = [ + qw(TABLE_CAT TABLE_SCHEM TABLE_NAME COLUMN_NAME DATA_TYPE + TYPE_NAME COLUMN_SIZE BUFFER_LENGTH DECIMAL_DIGITS + NUM_PREC_RADIX NULLABLE REMARKS COLUMN_DEF SQL_DATA_TYPE + SQL_DATETIME_SUB CHAR_OCTET_LENGTH ORDINAL_POSITION + IS_NULLABLE + ) + ]; + + # Technique of using DBD::Sponge borrowed from DBD::mysql... + sub column_info { + my $dbh = shift; + my $catalog = $dbh->quote(shift); + my $schema = $dbh->quote(shift); + my $table = $dbh->quote(shift); + my $column = $dbh->quote(shift); + + my $sth = + $dbh->prepare("sp_columns $table, $schema, $catalog, $column"); + return undef unless $sth; + + if ( !$sth->execute() ) { + return DBI::set_err( $dbh, $sth->err(), $sth->errstr() ); + } + my @cols; + while ( my $d = $sth->fetchrow_arrayref() ) { + push( @cols, [ @$d[ 0 .. 11 ], @$d[ 14 .. 19 ] ] ); + } + my $dbh2; + if ( !( $dbh2 = $dbh->{'~dbd_driver~_sponge_dbh'} ) ) { + $dbh2 = $dbh->{'~dbd_driver~_sponge_dbh'} = + DBI->connect("DBI:Sponge:"); + if ( !$dbh2 ) { + DBI::set_err( $dbh, 1, $DBI::errstr ); + return undef; + } + } + my $sth2 = $dbh2->prepare( + "SHOW COLUMNS", + { + 'rows' => \@cols, + 'NAME' => $names, + 'NUM_OF_FIELDS' => scalar(@$names) + } + ); + if ( !$sth2 ) { + DBI::set_err( $sth2, $dbh2->err(), $dbh2->errstr() ); + } + $sth2->execute; + $sth2; } - redo if $sth->{syb_more_results}; - } } - my $rows = $sth->rows; - - ($rows == 0) ? "0E0" : $rows; - } - # This will only work if the statement handle used to do the insert - # has been properly freed. Otherwise this will try to fetch @@identity - # from a different (new!) connection - which is obviously wrong. - sub last_insert_id { - my ($dbh, $catalog, $schema, $table, $field, $attr) = @_; - # parameters are ignored. - - my $sth = $dbh->prepare('select @@identity'); - if(!$sth->execute) { - return undef; - } - my $value; - ($value) = $sth->fetchrow_array; - $sth->finish; - - return $value; - } + sub primary_key_info { + my $dbh = shift; + my $catalog = $dbh->quote(shift); # == database in Sybase terms + my $schema = $dbh->quote(shift); # == owner in Sybase terms + my $table = $dbh->quote(shift); - sub table_info { - my $dbh = shift; - my $catalog = $dbh->quote(shift); - my $schema = $dbh->quote(shift); - my $table = $dbh->quote(shift); - my $type = $dbh->quote(shift); - - my $sth = $dbh->prepare("sp_tables $table, $schema, $catalog, $type"); -# Another possibility would be: -# select TABLE_QUALIFIER = NULL -# , TABLE_OWNER = u.name -# , TABLE_NAME = o.name -# , TABLE_TYPE = o.type -- XXX -# , REMARKS = NULL -# from sysobjects o -# , sysusers u -# where o.type in ('U', 'V', 'S') -# and o.uid = u.uid + my $sth = $dbh->prepare("sp_pkeys $table, $schema, $catalog"); - $sth->execute; - $sth; - } + $sth->execute; + $sth; + } -{ + sub foreign_key_info { + my $dbh = shift; + my $pk_catalog = $dbh->quote(shift); # == database in Sybase terms + my $pk_schema = $dbh->quote(shift); # == owner in Sybase terms + my $pk_table = $dbh->quote(shift); + my $fk_catalog = $dbh->quote(shift); # == database in Sybase terms + my $fk_schema = $dbh->quote(shift); # == owner in Sybase terms + my $fk_table = $dbh->quote(shift); - my $names = [qw(TABLE_CAT TABLE_SCHEM TABLE_NAME COLUMN_NAME DATA_TYPE - TYPE_NAME COLUMN_SIZE BUFFER_LENGTH DECIMAL_DIGITS - NUM_PREC_RADIX NULLABLE REMARKS COLUMN_DEF SQL_DATA_TYPE - SQL_DATETIME_SUB CHAR_OCTET_LENGTH ORDINAL_POSITION - IS_NULLABLE - )]; - - # Technique of using DBD::Sponge borrowed from DBD::mysql... - sub column_info { - my $dbh = shift; - my $catalog = $dbh->quote(shift); - my $schema = $dbh->quote(shift); - my $table = $dbh->quote(shift); - my $column = $dbh->quote(shift); - - my $sth = $dbh->prepare("sp_columns $table, $schema, $catalog, $column"); - return undef unless $sth; + my $sth = + $dbh->prepare( +"sp_fkeys $pk_table, $pk_catalog, $pk_schema, $fk_table, $fk_catalog, $fk_schema" + ); - if(!$sth->execute()) { - return DBI::set_err($dbh, $sth->err(), $sth->errstr()); + $sth->execute; + $sth; } - my @cols; - while(my $d = $sth->fetchrow_arrayref()) { - push(@cols, [@$d[0..11], @$d[14..19]]); - } - my $dbh2; - if (!($dbh2 = $dbh->{'~dbd_driver~_sponge_dbh'})) { - $dbh2 = $dbh->{'~dbd_driver~_sponge_dbh'} = - DBI->connect("DBI:Sponge:"); - if (!$dbh2) { - DBI::set_err($dbh, 1, $DBI::errstr); - return undef; - } - } - my $sth2 = $dbh2->prepare("SHOW COLUMNS", { 'rows' => \@cols, - 'NAME' => $names, - 'NUM_OF_FIELDS' => scalar(@$names) }); - if (!$sth2) { - DBI::set_err($sth2, $dbh2->err(), $dbh2->errstr()); - } - $sth2->execute; - $sth2; - } -} - sub primary_key_info { - my $dbh = shift; - my $catalog = $dbh->quote(shift); # == database in Sybase terms - my $schema = $dbh->quote(shift); # == owner in Sybase terms - my $table = $dbh->quote(shift); + sub statistics_info { + my $dbh = shift; + my $catalog = $dbh->quote(shift); # == database in Sybase terms + my $schema = $dbh->quote(shift); # == owner in Sybase terms + my $table = $dbh->quote(shift); + my $is_unique = shift; + my $quick = shift; - my $sth = $dbh->prepare("sp_pkeys $table, $schema, $catalog"); + my $sth = + $dbh->prepare( +"sp_indexes \@\@servername, $table, $catalog, $schema, NULL, $is_unique" + ); - $sth->execute; - $sth; - } + $sth->execute; + $sth; + } - sub ping_pl { # old code - now implemented by syb_ping() in dbdimp.c - my $dbh = shift; - return 0 if DBD::Sybase::db::_isdead($dbh); + sub ping_pl { # old code - now implemented by syb_ping() in dbdimp.c + my $dbh = shift; + return 0 if DBD::Sybase::db::_isdead($dbh); - # Use "select 1" suggested by Henri Asseily. - my $sth = $dbh->prepare("select 1"); + # Use "select 1" suggested by Henri Asseily. + my $sth = $dbh->prepare("select 1"); - return 0 if !$sth; + return 0 if !$sth; - my $rc = $sth->execute; - - # Changed && to || for 1.07. - return 0 if(!defined($rc) || DBD::Sybase::db::_isdead($dbh)); + my $rc = $sth->execute; - $sth->finish; - return 1; - } + # Changed && to || for 1.07. + return 0 if ( !defined($rc) || DBD::Sybase::db::_isdead($dbh) ); - sub type_info_all { - my ($dbh) = @_; - -# Calling sp_datatype_info returns the appropriate data for the server that -# we are currently connected to. -# In general the data is static, so it's not really necessary, but ASE 12.5 -# introduces some changes, in particular char/varchar max lenghts that depend -# on the server's page size. 12.5.1 introduces the DATE and TIME datatypes. - my $sth = $dbh->prepare("sp_datatype_info"); - my $data; - if($sth->execute) { - $data = $sth->fetchall_arrayref; - } - my $ti = - [ { TYPE_NAME => 0, - DATA_TYPE => 1, - PRECISION => 2, - LITERAL_PREFIX => 3, - LITERAL_SUFFIX => 4, - CREATE_PARAMS => 5, - NULLABLE => 6, - CASE_SENSITIVE => 7, - SEARCHABLE => 8, - UNSIGNED_ATTRIBUTE=> 9, - MONEY => 10, - AUTO_INCREMENT => 11, - LOCAL_TYPE_NAME => 12, - MINIMUM_SCALE => 13, - MAXIMUM_SCALE => 14, - sql_data_type => 15, - sql_datetime_sub => 16, - num_prec_radix => 17, - interval_precision => 18, - }, - ]; - # ASE 11.x only returns 13 columns: - my $c; - if(($c = scalar(@{$data->[0]})) < 19) { - foreach (keys(%{$ti->[0]})) { - if($ti->[0]->{$_} >= $c) { - delete($ti->[0]->{$_}); - } - } + $sth->finish; + return 1; } - push(@$ti, @$data); - return $ti; - } + sub type_info_all { + my ($dbh) = @_; - # First straight port of DBlib::nsql. - # mpeppler, 2/19/01 - # Updated by Merijn Broeren 4/17/2007 - # This version *can* handle ? placeholders - sub nsql { - my ($dbh, $sql, $type, $callback, $option) = @_; - my (@res, %resbytype); - my $retrycount = $dbh->FETCH('syb_deadlock_retry'); - my $retrysleep = $dbh->FETCH('syb_deadlock_sleep') || 60; - my $retryverbose = $dbh->FETCH('syb_deadlock_verbose'); - my $nostatus = $dbh->FETCH('syb_nsql_nostatus'); - - $option = $callback if ref($callback) eq 'HASH' - and ref($option) ne 'HASH'; - my $bytype = $option->{bytype} || 0; - my $merge = $bytype eq 'merge'; - - my @default_types = (DBD::Sybase::CS_ROW_RESULT(), DBD::Sybase::CS_CURSOR_RESULT(), - DBD::Sybase::CS_PARAM_RESULT(), DBD::Sybase::CS_MSG_RESULT(), - DBD::Sybase::CS_COMPUTE_RESULT() ); - my $oktypes = $option->{oktypes} || - ($nostatus ? [@default_types] : [@default_types, DBD::Sybase::CS_STATUS_RESULT()]); - my %oktypes = map {($_ => 1)} @$oktypes; - - my @params = $option->{arglist} ? @{$option->{arglist}} : (); + # Calling sp_datatype_info returns the appropriate data for the server that + # we are currently connected to. + # In general the data is static, so it's not really necessary, but ASE 12.5 + # introduces some changes, in particular char/varchar max lenghts that depend + # on the server's page size. 12.5.1 introduces the DATE and TIME datatypes. + my $sth = $dbh->prepare("sp_datatype_info"); + my $data; + if ( $sth->execute ) { + $data = $sth->fetchall_arrayref; + } + my $ti = [ + { + TYPE_NAME => 0, + DATA_TYPE => 1, + PRECISION => 2, + LITERAL_PREFIX => 3, + LITERAL_SUFFIX => 4, + CREATE_PARAMS => 5, + NULLABLE => 6, + CASE_SENSITIVE => 7, + SEARCHABLE => 8, + UNSIGNED_ATTRIBUTE => 9, + MONEY => 10, + AUTO_INCREMENT => 11, + LOCAL_TYPE_NAME => 12, + MINIMUM_SCALE => 13, + MAXIMUM_SCALE => 14, + sql_data_type => 15, + sql_datetime_sub => 16, + num_prec_radix => 17, + interval_precision => 18, + }, + ]; + + # ASE 11.x only returns 13 columns: + my $c; + if ( ( $c = scalar( @{ $data->[0] } ) ) < 19 ) { + foreach ( keys( %{ $ti->[0] } ) ) { + if ( $ti->[0]->{$_} >= $c ) { + delete( $ti->[0]->{$_} ); + } + } + } + push( @$ti, @$data ); - if ( ref $type ) { - $type = ref $type; + return $ti; } - elsif ( not defined $type ) { - $type = ""; - } - - my $sth = $dbh->prepare($sql); - return unless $sth; - my $raiserror = $dbh->FETCH('RaiseError'); + # First straight port of DBlib::nsql. + # mpeppler, 2/19/01 + # Updated by Merijn Broeren 4/17/2007 + # This version *can* handle ? placeholders + sub nsql { + my ( $dbh, $sql, $type, $callback, $option ) = @_; + my ( @res, %resbytype ); + my $retrycount = $dbh->FETCH('syb_deadlock_retry'); + my $retrysleep = $dbh->FETCH('syb_deadlock_sleep') || 60; + my $retryverbose = $dbh->FETCH('syb_deadlock_verbose'); + my $nostatus = $dbh->FETCH('syb_nsql_nostatus'); + + $option = $callback + if ref($callback) eq 'HASH' + and ref($option) ne 'HASH'; + my $bytype = $option->{bytype} || 0; + my $merge = $bytype eq 'merge'; + + my @default_types = ( + DBD::Sybase::CS_ROW_RESULT(), DBD::Sybase::CS_CURSOR_RESULT(), + DBD::Sybase::CS_PARAM_RESULT(), DBD::Sybase::CS_MSG_RESULT(), + DBD::Sybase::CS_COMPUTE_RESULT() + ); + my $oktypes = $option->{oktypes} + || ( $nostatus + ? [@default_types] + : [ @default_types, DBD::Sybase::CS_STATUS_RESULT() ] ); + my %oktypes = map { ( $_ => 1 ) } @$oktypes; - my $errstr; - my $err; + my @params = $option->{arglist} ? @{ $option->{arglist} } : (); - # Rats - RaiseError doesn't seem to work inside of this routine. - # So we fake it with lots of die() statements. -# $sth->{RaiseError} = 1; + if ( ref $type ) { + $type = ref $type; + } + elsif ( not defined $type ) { + $type = ""; + } - DEADLOCK: - { - # Initialize $err before each iteration through this loop. - # Otherwise, we inherit the value from the previous failure. + my $sth = $dbh->prepare($sql); + return unless $sth; - $err = undef; + my $raiserror = $dbh->FETCH('RaiseError'); - # ditto for @res, %resbytype - @res = (); - %resbytype = (); + my $errstr; + my $err; - # Use RaiseError technique to throw a fatal error if anything goes - # wrong in the execute or fetch phase. - eval { - $sth->execute(@params) || die $sth->errstr; + # Rats - RaiseError doesn't seem to work inside of this routine. + # So we fake it with lots of die() statements. + # $sth->{RaiseError} = 1; + + DEADLOCK: { - my $result_type = $sth->{syb_result_type}; - my (@set, $data); - if ( not exists $oktypes{$result_type} ) { - while ( $data = $sth->fetchrow_arrayref ) { - ; # do not include return status rows.. - } - } - elsif ( $type eq "HASH" ) { - while ( $data = $sth->fetchrow_hashref ) { - die $sth->errstr if($sth->err); - if ( ref $callback eq "CODE" ) { - unless ( $callback->(%$data) ) { - return; - } - } - else { - push(@set,{%$data}); - } + + # Initialize $err before each iteration through this loop. + # Otherwise, we inherit the value from the previous failure. + + $err = undef; + + # ditto for @res, %resbytype + @res = (); + %resbytype = (); + + # Use RaiseError technique to throw a fatal error if anything goes + # wrong in the execute or fetch phase. + eval { + $sth->execute(@params) || die $sth->errstr; + { + my $result_type = $sth->{syb_result_type}; + my ( @set, $data ); + if ( not exists $oktypes{$result_type} ) { + while ( $data = $sth->fetchrow_arrayref ) { + ; # do not include return status rows.. + } + } + elsif ( $type eq "HASH" ) { + while ( $data = $sth->fetchrow_hashref ) { + die $sth->errstr if ( $sth->err ); + if ( ref $callback eq "CODE" ) { + unless ( $callback->(%$data) ) { + return; + } + } + else { + push( @set, {%$data} ); + } + } + } + elsif ( $type eq "ARRAY" ) { + while ( $data = $sth->fetchrow_arrayref ) { + die $sth->errstr if ( $sth->err ); + if ( ref $callback eq "CODE" ) { + unless ( $callback->(@$data) ) { + return; + } + } + else { + push( @set, + ( @$data == 1 ? $$data[0] : [@$data] ) ); + } + } + } + else { + + # If you ask for nothing, you get nothing. But suck out + # the data just in case. + while ( $data = $sth->fetch ) { 1; } + + # NB this is actually *counting* the result sets which are not ignored above + $res[0]++; # Return non-null (true) + } + + die $sth->errstr if ( $sth->err ); + + if (@set) { + if ($merge) { + $resbytype{$result_type} ||= []; + push @{ $resbytype{$result_type} }, @set; + } + elsif ($bytype) { + push @res, { $result_type => [@set] }; + } + else { + push @res, @set; + } + } + + redo if $sth->{syb_more_results}; + } + }; + + # If $@ is set then something failed in the eval{} call above. + if ($@) { + $errstr = $@; + $err = $sth->err || $dbh->err; + if ( $retrycount && $err == 1205 ) { + if ( $retrycount < 0 || $retrycount-- ) { + carp "SQL deadlock encountered. Retrying...\n" + if $retryverbose; + sleep($retrysleep); + redo DEADLOCK; + } + else { + carp "SQL deadlock retry failed ", + $dbh->FETCH('syb_deadlock_retry'), + " times. Aborting.\n" + if $retryverbose; + last DEADLOCK; + } + } + + last DEADLOCK; + } + } + + # + # If we picked any sort of error, then don't feed the data back. + # + if ($err) { + if ($raiserror) { + croak($errstr); + } + return; + } + elsif ( ref $callback eq "CODE" ) { + return 1; + } + else { + if ($merge) { + return %resbytype; } - } - elsif ( $type eq "ARRAY" ) { - while ( $data = $sth->fetchrow_arrayref ) { - die $sth->errstr if($sth->err); - if ( ref $callback eq "CODE" ) { - unless ( $callback->(@$data) ) { - return; - } - } - else { - push(@set,( @$data == 1 ? $$data[0] : [@$data] )); - } + else { + return @res; } - } - else { - # If you ask for nothing, you get nothing. But suck out - # the data just in case. - while ( $data = $sth->fetch ) { 1; } - # NB this is actually *counting* the result sets which are not ignored above - $res[0]++; # Return non-null (true) - } - - die $sth->errstr if($sth->err); - - if (@set) { - if ($merge) { - $resbytype{$result_type} ||= []; - push @{$resbytype{$result_type}}, @set; - } elsif ($bytype) { - push @res, {$result_type => [@set]}; - } else { - push @res, @set; - } - } - - redo if $sth->{syb_more_results}; - } - }; - # If $@ is set then something failed in the eval{} call above. - if($@) { - $errstr = $@; - $err = $sth->err || $dbh->err; - if ( $retrycount && $err == 1205 ) { - if ( $retrycount < 0 || $retrycount-- ) { - carp "SQL deadlock encountered. Retrying...\n" if $retryverbose; - sleep($retrysleep); - redo DEADLOCK; - } - else { - carp "SQL deadlock retry failed ", $dbh->FETCH('syb_deadlock_retry'), " times. Aborting.\n" - if $retryverbose; - last DEADLOCK; - } - } - - last DEADLOCK; - } - } - # - # If we picked any sort of error, then don't feed the data back. - # - if ( $err ) { - if($raiserror) { - croak($errstr); - } - return; - } - elsif ( ref $callback eq "CODE" ) { - return 1; - } - else { - if ($merge) { - return %resbytype; - } else { - return @res; - } + } } - } - if($DBI::VERSION >= 1.37) { - *syb_nsql = *nsql; - } + if ( $DBI::VERSION >= 1.37 ) { + *syb_nsql = *nsql; + } } +{ -{ package DBD::Sybase::st; # ====== STATEMENT ====== - use strict; + package DBD::Sybase::st; # ====== STATEMENT ====== + use strict; - sub syb_output_params { - my ($sth) = @_; + sub syb_output_params { + my ($sth) = @_; - my @results; - my $status; + my @results; + my $status; - { - while(my $d = $sth->fetch) { - # The tie() doesn't work here, so call the FETCH method - # directly.... - if($sth->FETCH('syb_result_type') == 4042) { - push(@results, @$d); - } elsif($sth->FETCH('syb_result_type') == 4043) { - $status = $d->[0]; - } - } - redo if $sth->FETCH('syb_more_results'); + { + while ( my $d = $sth->fetch ) { + + # The tie() doesn't work here, so call the FETCH method + # directly.... + if ( $sth->FETCH('syb_result_type') == 4042 ) { + push( @results, @$d ); + } + elsif ( $sth->FETCH('syb_result_type') == 4043 ) { + $status = $d->[0]; + } + } + redo if $sth->FETCH('syb_more_results'); + } + + # XXX What to do if $status != 0??? + + @results; } - # XXX What to do if $status != 0??? - - @results; - } + sub exec_proc { + my ($sth) = @_; + + my @results; + my $status; - sub exec_proc { - my ($sth) = @_; + $sth->execute || return undef; - my @results; - my $status; + { + while ( my $d = $sth->fetch ) { - $sth->execute || return undef; + # The tie() doesn't work here, so call the FETCH method + # directly.... + if ( $sth->FETCH('syb_result_type') == 4043 ) { + $status = $d->[0]; + } + } + redo if $sth->FETCH('syb_more_results'); + } - { - while(my $d = $sth->fetch) { - # The tie() doesn't work here, so call the FETCH method - # directly.... - if($sth->FETCH('syb_result_type') == 4043) { - $status = $d->[0]; - } - } - redo if $sth->FETCH('syb_more_results'); + # XXX What to do if $status != 0??? + + $status; } - # XXX What to do if $status != 0??? - - $status; - } - } 1; @@ -648,6 +733,7 @@ variable, if it is set. =item host + =item port If you built DBD::Sybase with OpenClient 12.5.1 or later, then you can @@ -690,6 +776,12 @@ $dbh = DBI->connect("dbi:Sybase:charset=iso_1", $user, $passwd); +The default charset used depends on the locale that the application runs +in. If you wish to interact with unicode varaiables (see syb_enable_utf8, below) then +you should set charset=utf8. Note however that this means that Sybase will expect all +data sent to it for char/varchar columns to be encoded in utf8 (e.g. sending iso8859-1 characters +like e-grave, etc). + =item language Specify the language that the client uses. @@ -1229,6 +1321,17 @@ Default: off +=item syb_enable_utf8 (bool) + +If this attribute is set then DBD::Sybase will convert UNIVARCHAR, UNICHAR, +and UNITEXT data to Perl's internal utf-8 encoding when they are +retrieved. Updating a unicode column will cause Sybase to convert any incoming +data from utf-8 to its internal utf-16 encoding. + +This feature requires OpenClient 15.x to work. + +Default: off + =back =head2 Statement Handle Attributes @@ -1315,6 +1418,12 @@ Nov 15 1998 11:30:11:496AM +=item LONGMS + +New with ASE 15.5 - for bigtime/bigdatetime datatypes, includes microseconds: + +Apr 7 2010 10:40:33.532315PM + =item SHORT Nov 15 1998 11:30AM @@ -1886,6 +1995,17 @@ =head1 Other Private Methods +=head2 DBD::Sybase private Database Handle Methods + +=over 4 + +=item $bool = $dbh->syb_isdead + +Tests the connection to see if the connection has been marked DEAD by OpenClient. +The connection can get marked DEAD if an error occurs on the connection, or the connection fails. + +=back + =head2 DBD::Sybase private Statement Handle Methods =over 4 diff -Nru libdbd-sybase-perl-1.09/Sybase.xs libdbd-sybase-perl-1.14/Sybase.xs --- libdbd-sybase-perl-1.09/Sybase.xs 2007-04-10 15:42:21.000000000 +0000 +++ libdbd-sybase-perl-1.14/Sybase.xs 2011-04-25 09:00:44.000000000 +0000 @@ -1,7 +1,7 @@ /* -*-C-*- */ -/* $Id: Sybase.xs,v 1.17 2007/04/10 15:42:21 mpeppler Exp $ - Copyright (c) 1997-2007 Michael Peppler +/* $Id: Sybase.xs,v 1.19 2011/04/25 08:59:17 mpeppler Exp $ + Copyright (c) 1997-2011 Michael Peppler Uses from Driver.xst Copyright (c) 1994,1995,1996,1997 Tim Bunce @@ -73,7 +73,7 @@ syb_date_fmt = 1 CODE: D_imp_dbh(dbh); - ST(0) = syb_db_date_fmt(dbh, imp_dbh, fmt) ? &sv_yes : &sv_no; + ST(0) = syb_db_date_fmt(dbh, imp_dbh, fmt) ? &PL_sv_yes : &PL_sv_no; void ping(dbh) @@ -92,7 +92,7 @@ syb_cancel = 1 CODE: D_imp_sth(sth); - ST(0) = syb_st_cancel(sth, imp_sth) ? &sv_yes : &sv_no; + ST(0) = syb_st_cancel(sth, imp_sth) ? &PL_sv_yes : &PL_sv_no; void ct_get_data(sth, column, bufrv, buflen=0) @@ -126,7 +126,7 @@ } else if (strEQ(action, "CS_GET")) { sybaction = CS_GET; } - ST(0) = syb_ct_data_info(sth, imp_sth, sybaction, column, attr) ? &sv_yes : &sv_no; + ST(0) = syb_ct_data_info(sth, imp_sth, sybaction, column, attr) ? &PL_sv_yes : &PL_sv_no; } void @@ -138,7 +138,7 @@ syb_ct_send_data = 1 CODE: D_imp_sth(sth); - ST(0) = syb_ct_send_data(sth, imp_sth, buffer, size) ? &sv_yes : &sv_no; + ST(0) = syb_ct_send_data(sth, imp_sth, buffer, size) ? &PL_sv_yes : &PL_sv_no; void ct_prepare_send(sth) @@ -147,7 +147,7 @@ syb_ct_prepare_send = 1 CODE: D_imp_sth(sth); - ST(0) = syb_ct_prepare_send(sth, imp_sth) ? &sv_yes : &sv_no; + ST(0) = syb_ct_prepare_send(sth, imp_sth) ? &PL_sv_yes : &PL_sv_no; void ct_finish_send(sth) @@ -156,7 +156,7 @@ syb_ct_finish_send = 1 CODE: D_imp_sth(sth); - ST(0) = syb_ct_finish_send(sth, imp_sth) ? &sv_yes : &sv_no; + ST(0) = syb_ct_finish_send(sth, imp_sth) ? &PL_sv_yes : &PL_sv_no; void syb_describe(sth, doAssoc = 0) diff -Nru libdbd-sybase-perl-1.09/t/main.t libdbd-sybase-perl-1.14/t/main.t --- libdbd-sybase-perl-1.09/t/main.t 2007-04-13 16:08:05.000000000 +0000 +++ libdbd-sybase-perl-1.14/t/main.t 2011-04-25 09:00:44.000000000 +0000 @@ -1,6 +1,6 @@ #!perl # -# $Id: main.t,v 1.19 2007/04/13 16:08:05 mpeppler Exp $ +# $Id: main.t,v 1.21 2010/04/07 20:53:38 mpeppler Exp $ # Base DBD Driver Test @@ -9,7 +9,7 @@ use strict; -use Test::More tests=>34; +use Test::More tests=>36; #use Test::More qw(no_plan); use Data::Dumper; @@ -210,6 +210,18 @@ } } +SKIP: { + skip 'requires ASE 15.5 ', 2 unless $dbh->{syb_server_version} ge '15.5'; + $dbh->{PrintError} = 1; + $dbh->syb_date_fmt('LONGMS'); + my $sth = $dbh->prepare("select current_bigdatetime(), current_bigtime()"); + $sth->execute; + while(my $r = $sth->fetch) { + print "@$r\n"; + ok(1 == 1, "bigdatetime"); + ok(1 == 1, "bigtime"); + } +} $dbh->disconnect; diff -Nru libdbd-sybase-perl-1.09/t/utf8.t libdbd-sybase-perl-1.14/t/utf8.t --- libdbd-sybase-perl-1.09/t/utf8.t 1970-01-01 00:00:00.000000000 +0000 +++ libdbd-sybase-perl-1.14/t/utf8.t 2011-10-02 15:01:55.000000000 +0000 @@ -0,0 +1,172 @@ +#!perl +# +# $Id: utf8.t,v 1.5 2011/10/02 15:01:50 mpeppler Exp $ + +use lib 't'; +use _test; + +use strict; + +use Test::More; + +BEGIN { + plan skip_all => 'This test requires Perl 5.8+' + unless $] >= 5.008; + +} + +use DBI; +use DBD::Sybase; +use Encode (); + +binmode( $_, 'utf8' ) + for map { Test::Builder->new->$_() } + qw( output failure_output todo_output ); + +use vars qw($Pwd $Uid $Srv $Db); + +( $Uid, $Pwd, $Srv, $Db ) = _test::get_info(); + +my $dbh = DBI->connect( + "dbi:Sybase:server=$Srv;database=$Db;charset=utf8", $Uid, $Pwd, + { PrintError => 1 } +); +$dbh->{syb_enable_utf8} = 1; + + +unless ( $dbh->{syb_server_version} ge '15' && $dbh->{syb_enable_utf8}) { + plan skip_all => 'This test requires ASE 15 or later, and OpenClient 15.x or later'; +} + +plan tests => 11; + +$dbh->do("create table #utf8test (uv univarchar(510), ut unitext)"); + +my $ascii = 'Some text'; +#my $utf8 = "पट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट्टपट"; +my $utf8 = "\x{263A} - smiley1 - \x{263B} - smiley2" x 10; + +{ + my $quoted = $dbh->quote($ascii); + $dbh->do("insert into #utf8test (uv, ut) values ($quoted, $quoted)"); + + my $rows = $dbh->selectall_arrayref( + "select * from #utf8test", + { Slice => {} } + ); + + is_deeply( + $rows, + [ + { + uv => $ascii, + ut => $ascii, + } + ], + "got expected row back from #utf8test" + ); + + ok( + !Encode::is_utf8( $rows->[0]{uv} ), + 'uv column was returned with utf8 flag off' + ); + + ok( + !Encode::is_utf8( $rows->[0]{ut} ), + 'ut column was returned with utf8 flag off' + ); +} + +{ + $dbh->do("delete from #utf8test"); + + my $quoted = $dbh->quote($utf8); + $dbh->do("insert into #utf8test (uv, ut) values ($quoted, $quoted)"); + + my $rows = $dbh->selectall_arrayref( + "select * from #utf8test", + { Slice => {} } + ); + + is_deeply( + $rows, + [ + { + uv => $utf8, + ut => $utf8, + } + ], + "got expected row back from #utf8test" + ); + + ok( + Encode::is_utf8( $rows->[0]{uv} ), + 'uv column was returned with utf8 flag on' + ); + + ok( + Encode::is_utf8( $rows->[0]{ut} ), + 'ut column was returned with utf8 flag on' + ); +} + +$dbh->{syb_enable_utf8} = 0; + +{ + my $rows = $dbh->selectall_arrayref( + "select * from #utf8test", + { Slice => {} } + ); + + ok( + !Encode::is_utf8( $rows->[0]{uv} ), + 'uv column was returned with utf8 flag off (syb_enable_utf8 was false)' + ); + + ok( + !Encode::is_utf8( $rows->[0]{ut} ), + 'ut column was returned with utf8 flag off (syb_enable_utf8 was false)' + ); +} + +{ + my $dbh2 = DBI->connect( + "dbi:Sybase:server=$Srv;database=$Db;charset=utf8", + $Uid, $Pwd, { + PrintError => 1, + syb_enable_utf8 => 1 + } + ); + + $dbh2->do("create table #utf8test (uv univarchar(250), ut unitext)"); + + my $quoted = $dbh->quote($utf8); + $dbh2->do("insert into #utf8test (uv, ut) values ($quoted, $quoted)"); + + my $rows = $dbh2->selectall_arrayref( + "select * from #utf8test", + { Slice => {} } + ); + + is_deeply( + $rows, + [ + { + uv => $utf8, + ut => $utf8, + } + ], + "got expected row back from #utf8test" + ); + + ok( + Encode::is_utf8( $rows->[0]{uv} ), + 'uv column was returned with utf8 flag on (syb_enable_utf8 passed to connect)' + ); + + ok( + Encode::is_utf8( $rows->[0]{ut} ), + 'ut column was returned with utf8 flag on (syb_enable_utf8 passed to connect)' + ); +} +