1 /* $Id: dbdimp.c,v 1.116 2017/09/10 14:31:45 mpeppler Exp $
2
3 Copyright (c) 1997-2011 Michael Peppler
4
5 You may distribute under the terms of either the GNU General Public
6 License or the Artistic License, as specified in the Perl README file.
7
8 Based on DBD::Oracle dbdimp.c, Copyright (c) 1994,1995 Tim Bunce
9
10 */
11 #include "Sybase.h"
12 /* Defines needed for perl 5.005 / threading */
13 #if defined(op)
14 #undef op
15 #endif
16 #if !defined(PATCHLEVEL)
17 #include "patchlevel.h" /* this is the perl patchlevel.h */
18 #endif
19 #if PATCHLEVEL < 5 && SUBVERSION < 5
20 #define PL_na na
21 #define PL_sv_undef sv_undef
22 #define PL_dirty dirty
23 #endif
24 #ifndef PerlIO
25 # define PerlIO FILE
26 # define PerlIO_printf fprintf
27 # define PerlIO_stderr() stderr
28 # define PerlIO_close(f) fclose(f)
29 # define PerlIO_open(f,m) fopen(f,m)
30 # define PerlIO_flush(f) fflush(f)
31 # define PerlIO_puts(f,s) fputs(s,f)
32 #endif
33 /* Requested by Alex Fridman */
34 #ifdef WIN32
35 # define strncasecmp _strnicmp
36 #endif
37 /*#define NO_CHAINED_TRAN 1*/
38 #if !defined(NO_CHAINED_TRAN)
39 #define NO_CHAINED_TRAN 0
40 #endif
41 /* some systems have trouble with ct_cancel().
42 If FLUSH_FINISH is 1 then the default behavior is to fetch all results
43 from the server when $sth->finish() is called instead of the normal
44 ct_cancel(CS_CANCEL_ALL) call. */
45 #if !defined(FLUSH_FINISH)
46 #define FLUSH_FINISH 0
47 #endif
48 #if !defined(PROC_STATUS)
49 #define PROC_STATUS 0
50 #endif
51 /*
52 * In DBD::Sybase 1.09 and before, certain large numeric types (money, bigint)
53 * were being kept in native format, and then returned to the caller as a perl NV
54 * data item. An NV is really a float, so there was loss of precision, especially for bigint
55 * data which is a 64bit int.
56 * In 1.10 these datatypes behave the same way as numeric/decimal - converted to a char string
57 * and returned that way to the caller, who can then use Math::BigInt, etc.
58 * If you want to revert to the previous behavior, you need to define SYB_NATIVE_NUM.
59 *
60 * #define SYB_NATIVE_NUM
61 */
62 /* FreeTDS doesn't always define these symbols */
63 #if defined(CS_VERSION_110)
64 #if !defined BLK_VERSION_110
65 #define BLK_VERSION_110 BLK_VERSION_100
66 #endif
67 #endif
68 #if defined(CS_VERSION_120)
69 #if !defined BLK_VERSION_120
70 #define BLK_VERSION_120 BLK_VERSION_110
71 #endif
72 #endif
73 #if defined(CS_VERSION_125)
74 #if !defined BLK_VERSION_125
75 #define BLK_VERSION_125 BLK_VERSION_120
76 #endif
77 #endif
78 #if defined(CS_VERSION_150)
79 #if !defined BLK_VERSION_150
80 #define BLK_VERSION_150 BLK_VERSION_125
81 #endif
82 #endif
83 #if defined(CS_VERSION_155)
84 #if !defined BLK_VERSION_155
85 #define BLK_VERSION_155 BLK_VERSION_150
86 #endif
87 #endif
88 #if defined(CS_VERSION_157)
89 #if !defined BLK_VERSION_157
90 #define BLK_VERSION_157 BLK_VERSION_155
91 #endif
92 #endif
93 #if !defined(CS_LONGCHAR_TYPE)
94 #define CS_LONGCHAR_TYPE CS_CHAR_TYPE
95 #endif
96 DBISTATE_DECLARE;
97
98 static void cleanUp _((imp_sth_t *));
99 static char *GetAggOp _((CS_INT));
100 static CS_INT get_cwidth _((CS_DATAFMT *));
101 static CS_INT display_dlen _((CS_DATAFMT *));
102 static CS_RETCODE display_header _((imp_dbh_t *, CS_INT, CS_DATAFMT*));
103 static CS_RETCODE describe _((SV *sth, imp_sth_t *, int));
104 static CS_RETCODE fetch_data _((imp_dbh_t *, CS_COMMAND*));
105 static CS_RETCODE CS_PUBLIC clientmsg_cb _((CS_CONTEXT*, CS_CONNECTION*, CS_CLIENTMSG*));
106 static CS_RETCODE CS_PUBLIC servermsg_cb _((CS_CONTEXT*, CS_CONNECTION*, CS_SERVERMSG*));
107 static CS_RETCODE CS_PUBLIC cslibmsg_cb(CS_CONTEXT *context,
108 CS_CLIENTMSG *errmsg);
109 static CS_COMMAND *syb_alloc_cmd _((imp_dbh_t *, CS_CONNECTION*));
110 static void dealloc_dynamic _((imp_sth_t *));
111 static int map_syb_types _((int));
112 static int map_sql_types _((int));
113 static CS_CONNECTION *syb_db_connect _((struct imp_dbh_st *));
114 static int syb_db_use _((imp_dbh_t *, CS_CONNECTION *));
115 static int syb_st_describe_proc _((imp_sth_t *, char *));
116 static void syb_set_error(imp_dbh_t *, int, char *);
117 static char *my_strdup _((char *));
118 static void fetchKerbTicket(imp_dbh_t *imp_dbh);
119 static CS_RETCODE syb_blk_init(imp_dbh_t *imp_dbh, imp_sth_t *imp_sth);
120 static void blkCleanUp(imp_sth_t *imp_sth, imp_dbh_t *imp_dbh);
121 static int getTableName(char *statement, char *table, int maxwidth);
122 static int toggle_autocommit(SV *dbh, imp_dbh_t *imp_dbh, int flag);
123 static int datetime2str(CS_DATETIME *dt, CS_DATAFMT *srcfmt, char *buff,
124 CS_INT len, int type, CS_LOCALE *locale);
125 #if defined(CS_DATE_TYPE)
126 static int date2str(CS_DATE *dt, CS_DATAFMT *srcfmt, char *buff, CS_INT len,
127 int type, CS_LOCALE *locale);
128 static int time2str(CS_TIME *dt, CS_DATAFMT *srcfmt, char *buff, CS_INT len,
129 int type, CS_LOCALE *locale);
130 #endif
131 static int syb_get_date_fmt(imp_dbh_t *imp_dbh, char *fmt);
132 static int cmd_execute(SV *sth, imp_sth_t *imp_sth);
133 #if defined(DBD_CAN_HANDLE_UTF8)
134 static int is_high_bit_set(const unsigned char *val, STRLEN size);
135 #endif
136 static CS_BINARY *to_binary(char *str, STRLEN *outlen);
137 static int get_server_version(SV *dbh, imp_dbh_t *imp_dbh, CS_CONNECTION *con);
138 static void clear_cache(SV *sth, imp_sth_t *imp_sth);
139
140 static int _dbd_rebind_ph(SV *sth, imp_sth_t *imp_sth, phs_t *phs, int maxlen);
141
142 static CS_INT BLK_VERSION;
143
144 #if PERL_VERSION >= 8 && defined(_REENTRANT)
145 static perl_mutex context_alloc_mutex[1];
146 #endif
147
148 /*#define USE_CSLIB_CB 1 */
149
150 static CS_CONTEXT *context;
151 static CS_LOCALE *locale;
152 static char scriptName[255];
153 static char hostname[255];
154 static char *ocVersion;
155
156 #define LOCALE(s) ((s)->locale ? (s)->locale : locale)
157
158 static SV *cslib_cb;
159
syb_set_options(imp_dbh_t * imp_dbh,CS_INT action,CS_INT option,CS_VOID * value,CS_INT len,CS_INT * outlen)160 static int syb_set_options(imp_dbh_t *imp_dbh, CS_INT action, CS_INT option,
161 CS_VOID *value, CS_INT len, CS_INT *outlen) {
162 if (DBIc_DBISTATE(imp_dbh)->debug >= 5)
163 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
164 " syb_set_options: optSupported = %d\n",
165 imp_dbh->optSupported);
166
167 if (!imp_dbh->optSupported)
168 return CS_FAIL;
169
170 return ct_options(imp_dbh->connection, action, option, value, len, outlen);
171 }
172
syb_set_error(imp_dbh_t * imp_dbh,int err,char * errstr)173 static void syb_set_error(imp_dbh_t *imp_dbh, int err, char *errstr) {
174 dTHX;
175 sv_setiv(DBIc_ERR(imp_dbh), err);
176 if (SvOK(DBIc_ERRSTR(imp_dbh)))
177 sv_catpv(DBIc_ERRSTR(imp_dbh), errstr);
178 else
179 sv_setpv(DBIc_ERRSTR(imp_dbh), errstr);
180 }
181
182 static CS_RETCODE CS_PUBLIC
cslibmsg_cb(CS_CONTEXT * context,CS_CLIENTMSG * errmsg)183 cslibmsg_cb(CS_CONTEXT *context, CS_CLIENTMSG *errmsg) {
184 dTHX;
185
186 #if 0
187 if(DBIS->debug >= 4) {
188 PerlIO_printf(DBILOGFP, " cslibmsg_cb -> %s\n", errmsg->msgstring);
189 if (errmsg->osstringlen> 0) {
190 PerlIO_printf(DBILOGFP, " cslibmsg_cb -> %s\n", errmsg->osstring);
191 }
192 }
193 #endif
194
195 if (cslib_cb) {
196 dSP;
197 int retval, count;
198
199 ENTER;
200 SAVETMPS;
201 PUSHMARK(sp);
202
203 XPUSHs(sv_2mortal(newSViv(CS_LAYER(errmsg->msgnumber))));
204 XPUSHs(sv_2mortal(newSViv(CS_ORIGIN(errmsg->msgnumber))));
205 XPUSHs(sv_2mortal(newSViv(CS_SEVERITY(errmsg->msgnumber))));
206 XPUSHs(sv_2mortal(newSViv(CS_NUMBER(errmsg->msgnumber))));
207 XPUSHs(sv_2mortal(newSVpv(errmsg->msgstring, 0)));
208 if (errmsg->osstringlen > 0)
209 XPUSHs(sv_2mortal(newSVpv(errmsg->osstring, 0)));
210 else
211 XPUSHs(&PL_sv_undef);
212
213 PUTBACK;
214 if ((count = perl_call_sv(cslib_cb, G_SCALAR)) != 1)
215 croak("A cslib handler cannot return a LIST");
216 SPAGAIN;
217 retval = POPi;
218
219 PUTBACK;
220 FREETMPS;
221 LEAVE;
222
223 return retval;
224 }
225 PerlIO_printf(PerlIO_stderr(), "\nCS Library Message:\n");
226 PerlIO_printf(PerlIO_stderr(),
227 "Message number: LAYER = (%ld) ORIGIN = (%ld) ",
228 CS_LAYER(errmsg->msgnumber), CS_ORIGIN(errmsg->msgnumber));
229 PerlIO_printf(PerlIO_stderr(), "SEVERITY = (%ld) NUMBER = (%ld)\n",
230 CS_SEVERITY(errmsg->msgnumber), CS_NUMBER(errmsg->msgnumber));
231 PerlIO_printf(PerlIO_stderr(), "Message String: %s\n", errmsg->msgstring);
232 if (errmsg->osstringlen > 0) {
233 PerlIO_printf(PerlIO_stderr(), "Operating System Error: %s\n",
234 errmsg->osstring);
235 }
236
237 return CS_SUCCEED;
238 }
239
240 static CS_RETCODE CS_PUBLIC
clientmsg_cb(CS_CONTEXT * context,CS_CONNECTION * connection,CS_CLIENTMSG * errmsg)241 clientmsg_cb(CS_CONTEXT *context, CS_CONNECTION *connection,
242 CS_CLIENTMSG *errmsg) {
243 dTHX;
244 imp_dbh_t *imp_dbh = NULL;
245 char buff[255];
246
247 if (connection) {
248 if ((ct_con_props(connection, CS_GET, CS_USERDATA, &imp_dbh,
249 CS_SIZEOF(imp_dbh), NULL)) != CS_SUCCEED)
250 croak("Panic: clientmsg_cb: Can't find handle from connection");
251
252 if(DBIc_DBISTATE(imp_dbh)->debug >= 4) {
253 PerlIO_printf(DBIc_LOGPIO(imp_dbh), " clientmsg_cb -> %s\n",
254 errmsg->msgstring);
255 if (errmsg->osstringlen> 0) {
256 PerlIO_printf(DBIc_LOGPIO(imp_dbh), " clientmsg_cb -> %s\n",
257 errmsg->osstring);
258 }
259 }
260
261 /* if LongTruncOK is set then ignore this error. */
262 if(DBIc_is(imp_dbh, DBIcf_LongTruncOk) &&
263 CS_NUMBER(errmsg->msgnumber) == 132)
264 return CS_SUCCEED;
265
266 if(imp_dbh->err_handler) {
267 dSP;
268 int retval, count;
269
270 ENTER;
271 SAVETMPS;
272 PUSHMARK(sp);
273
274 XPUSHs(sv_2mortal(newSViv(CS_NUMBER(errmsg->msgnumber))));
275 XPUSHs(sv_2mortal(newSViv(CS_SEVERITY(errmsg->msgnumber))));
276 XPUSHs(sv_2mortal(newSViv(0)));
277 XPUSHs(sv_2mortal(newSViv(0)));
278 XPUSHs(&PL_sv_undef);
279 XPUSHs(&PL_sv_undef);
280 XPUSHs(sv_2mortal(newSVpv(errmsg->msgstring, 0)));
281 if(imp_dbh->sql)
282 XPUSHs(sv_2mortal(newSVpv(imp_dbh->sql, 0)));
283 else
284 XPUSHs(&PL_sv_undef);
285
286 XPUSHs(sv_2mortal(newSVpv("client", 0)));
287
288 PUTBACK;
289 if((count = perl_call_sv(imp_dbh->err_handler, G_SCALAR | G_EVAL)) != 1)
290 croak("An error handler can't return a LIST.");
291 SPAGAIN;
292
293 if(SvTRUE(ERRSV)) {
294 POPs;
295 retval = 1;
296 } else {
297 retval = POPi;
298 }
299
300 PUTBACK;
301 FREETMPS;
302 LEAVE;
303
304 /* If the called sub returns 0 then ignore this error */
305 if(retval == 0)
306 return CS_SUCCEED;
307 }
308
309 sv_setiv(DBIc_ERR(imp_dbh), (IV)CS_NUMBER(errmsg->msgnumber));
310
311 if(SvOK(DBIc_ERRSTR(imp_dbh)))
312 sv_catpv(DBIc_ERRSTR(imp_dbh), "OpenClient message: ");
313 else
314 sv_setpv(DBIc_ERRSTR(imp_dbh), "OpenClient message: ");
315 sprintf(buff, "LAYER = (%ld) ORIGIN = (%ld) ",
316 CS_LAYER(errmsg->msgnumber), CS_ORIGIN(errmsg->msgnumber));
317 sv_catpv(DBIc_ERRSTR(imp_dbh), buff);
318 sprintf(buff, "SEVERITY = (%ld) NUMBER = (%ld)\n",
319 CS_SEVERITY(errmsg->msgnumber), CS_NUMBER(errmsg->msgnumber));
320 sv_catpv(DBIc_ERRSTR(imp_dbh), buff);
321 sprintf(buff, "Server %s, database %s\n",
322 imp_dbh->server, imp_dbh->curr_db);
323 sv_catpv(DBIc_ERRSTR(imp_dbh), buff);
324 sv_catpv(DBIc_ERRSTR(imp_dbh), "Message String: ");
325 sv_catpv(DBIc_ERRSTR(imp_dbh), errmsg->msgstring);
326 sv_catpv(DBIc_ERRSTR(imp_dbh), "\n");
327 if (errmsg->osstringlen> 0) {
328 sv_catpv(DBIc_ERRSTR(imp_dbh), "Operating System Error: ");
329 sv_catpv(DBIc_ERRSTR(imp_dbh), errmsg->osstring);
330 sv_catpv(DBIc_ERRSTR(imp_dbh), "\n");
331 }
332
333 if(CS_NUMBER(errmsg->msgnumber) == 6) { /* disconnect */
334 imp_dbh->isDead = 1;
335 }
336
337 /* If this is a timeout message, cancel the current request.
338 If the cancel fails, then return CS_FAIL, and mark
339 the connection dead.
340 Do NOT return CS_FAIL in all cases, as this makes the
341 connection unusable, and that may not be the correct
342 behavior in all situations. */
343
344 if (CS_SEVERITY(errmsg->msgnumber) == CS_SV_RETRY_FAIL &&
345 CS_NUMBER(errmsg->msgnumber) == 63 &&
346 CS_ORIGIN(errmsg->msgnumber) == 2 &&
347 CS_LAYER(errmsg->msgnumber) == 1) {
348 CS_INT status;
349
350 status = 0;
351 if (ct_con_props(connection, CS_GET, CS_LOGIN_STATUS,
352 (CS_VOID *)&status,
353 CS_UNUSED, NULL) != CS_SUCCEED) {
354 imp_dbh->isDead = 1;
355 return CS_FAIL;
356 }
357 if (!status) {
358 /* We're not logged in, so just return CS_FAIL to abort
359 the login request */
360 imp_dbh->isDead = 1;
361 return CS_FAIL;
362 }
363 if(ct_cancel(connection, NULL, CS_CANCEL_ATTN) == CS_FAIL) {
364 imp_dbh->isDead = 1;
365 return CS_FAIL;
366 }
367 return CS_SUCCEED;
368 }
369 } else { /* !connection */
370 PerlIO_printf(PerlIO_stderr(), "OpenClient message: ");
371 PerlIO_printf(PerlIO_stderr(), "LAYER = (%ld) ORIGIN = (%ld) ",
372 CS_LAYER(errmsg->msgnumber), CS_ORIGIN(errmsg->msgnumber));
373 PerlIO_printf(PerlIO_stderr(), "SEVERITY = (%ld) NUMBER = (%ld)\n",
374 CS_SEVERITY(errmsg->msgnumber), CS_NUMBER(errmsg->msgnumber));
375 PerlIO_printf(PerlIO_stderr(), "Message String: %s\n", errmsg->msgstring);
376 if (errmsg->osstringlen> 0) {
377 PerlIO_printf(PerlIO_stderr(), "Operating System Error: %s\n",
378 errmsg->osstring);
379 }
380 }
381
382 return CS_SUCCEED;
383 }
384
385 static CS_RETCODE CS_PUBLIC
servermsg_cb(CS_CONTEXT * context,CS_CONNECTION * connection,CS_SERVERMSG * srvmsg)386 servermsg_cb(CS_CONTEXT *context, CS_CONNECTION *connection,
387 CS_SERVERMSG *srvmsg) {
388 CS_COMMAND *cmd;
389 CS_RETCODE retcode;
390 imp_dbh_t *imp_dbh = NULL;
391 char buff[1024];
392 dTHX;
393
394 /* add check on connection not being NULL (PR/477)
395 just to be on the safe side - freetds can call the server
396 callback with a NULL connection */
397 if (connection && (ct_con_props(connection, CS_GET, CS_USERDATA, &imp_dbh,
398 CS_SIZEOF(imp_dbh), NULL)) != CS_SUCCEED)
399 croak("Panic: servermsg_cb: Can't find handle from connection");
400
401 if(imp_dbh && DBIc_DBISTATE(imp_dbh)->debug >= 4) {
402 if(srvmsg->msgnumber) {
403 PerlIO_printf(DBIc_LOGPIO(imp_dbh)," servermsg_cb -> number=%ld severity=%ld ",
404 srvmsg->msgnumber, srvmsg->severity);
405 PerlIO_printf(DBIc_LOGPIO(imp_dbh), "state=%ld line=%ld ",
406 srvmsg->state, srvmsg->line);
407 if (srvmsg->svrnlen> 0) {
408 PerlIO_printf(DBIc_LOGPIO(imp_dbh), "server=%s ", srvmsg->svrname);
409 }
410 if (srvmsg->proclen> 0) {
411 PerlIO_printf(DBIc_LOGPIO(imp_dbh), "procedure=%s ", srvmsg->proc);
412 }
413 PerlIO_printf(DBIc_LOGPIO(imp_dbh), "text=%s\n", srvmsg->text);
414 } else {
415 PerlIO_printf(DBIc_LOGPIO(imp_dbh), " servermsg_cb -> %s\n", srvmsg->text);
416 }
417 }
418 /* Track the "current" database */
419 /* Borrowed from sqsh's cmd_connect.c */
420 if(srvmsg->msgnumber == 5701 || srvmsg->msgnumber == 5703
421 || srvmsg->msgnumber == 5704)
422 {
423 char *c;
424 int i;
425 if(srvmsg->text != NULL && (c = strchr( srvmsg->text, '\'' )) != NULL)
426 {
427 i = 0;
428 for( ++c; i <= 30 && *c != '\0' && *c != '\''; ++c )
429 buff[i++] = *c;
430 buff[i] = '\0';
431
432 /*
433 * On some systems, if the charset is mis-configured in the
434 * SQL Server, it will come back as the string "<NULL>". If
435 * this is the case, then we want to ignore this value.
436 */
437 if (strcmp( buff, "<NULL>" ) != 0)
438 {
439 switch (srvmsg->msgnumber)
440 {
441 case 5701:
442 if(imp_dbh && DBIc_ACTIVE(imp_dbh) &&
443 imp_dbh->connection == connection) {
444 strcpy(imp_dbh->curr_db, buff);
445 }
446 break;
447 case 5703: /* Language */
448 break;
449 case 5704: /* charset */
450 break;
451 default:
452 break;
453 }
454 }
455 }
456 return CS_SUCCEED;
457 }
458
459 /* Trap msg 17001 (No SRV_OPTION handler installed.) */
460 if(imp_dbh && srvmsg->msgnumber == 17001) {
461 imp_dbh->optSupported = 0;
462 if(DBIc_DBISTATE(imp_dbh)->debug >= 4) {
463 PerlIO_printf(DBIc_LOGPIO(imp_dbh), " servermsg_cb() -> ct_option is %ssupported\n", imp_dbh->optSupported == 1 ?"":"not ");
464 }
465 }
466
467 if(imp_dbh && imp_dbh->err_handler) {
468 dSP;
469 int retval, count;
470
471 ENTER;
472 SAVETMPS;
473 PUSHMARK(sp);
474
475 XPUSHs(sv_2mortal(newSViv(srvmsg->msgnumber)));
476 XPUSHs(sv_2mortal(newSViv(srvmsg->severity)));
477 XPUSHs(sv_2mortal(newSViv(srvmsg->state)));
478 XPUSHs(sv_2mortal(newSViv(srvmsg->line)));
479 if(srvmsg->svrnlen> 0)
480 XPUSHs(sv_2mortal(newSVpv(srvmsg->svrname, 0)));
481 else
482 XPUSHs(&PL_sv_undef);
483 if(srvmsg->proclen> 0)
484 XPUSHs(sv_2mortal(newSVpv(srvmsg->proc, 0)));
485 else
486 XPUSHs(&PL_sv_undef);
487 XPUSHs(sv_2mortal(newSVpv(srvmsg->text, 0)));
488
489 if(imp_dbh->sql)
490 XPUSHs(sv_2mortal(newSVpv(imp_dbh->sql, 0)));
491 else
492 XPUSHs(&PL_sv_undef);
493
494 XPUSHs(sv_2mortal(newSVpv("server", 0)));
495
496 PUTBACK;
497 if((count = perl_call_sv(imp_dbh->err_handler, G_SCALAR | G_EVAL)) != 1)
498 croak("An error handler can't return a LIST.");
499 SPAGAIN;
500
501 if(SvTRUE(ERRSV)) {
502 POPs;
503 retval = 1;
504 } else {
505 retval = POPi;
506 }
507
508 PUTBACK;
509 FREETMPS;
510 LEAVE;
511
512 /* If the called sub returns 0 then ignore this error */
513 if(retval == 0)
514 return CS_SUCCEED;
515 }
516
517 if(imp_dbh && srvmsg->msgnumber) {
518 /* error 5702 (severity=10 state=1 text=ASE is terminating this process)
519 * may be delivered only via servermsg_cb. If we don't deal with it here
520 * the command can appear to complete successfully. errstr will contain
521 * the error message but err will be false.
522 */
523 if(srvmsg->severity> 10 || srvmsg->msgnumber == 5702) {
524 sv_setiv(DBIc_ERR(imp_dbh), (IV)srvmsg->msgnumber);
525
526 imp_dbh->lasterr = srvmsg->msgnumber;
527 imp_dbh->lastsev = srvmsg->severity;
528
529 if (srvmsg->msgnumber == 5702) {
530 ct_close(connection, CS_FORCE_CLOSE);
531 imp_dbh->isDead = 1;
532 }
533 }
534
535 if(SvOK(DBIc_ERRSTR(imp_dbh)))
536 sv_catpv(DBIc_ERRSTR(imp_dbh), "Server message ");
537 else
538 sv_setpv(DBIc_ERRSTR(imp_dbh), "Server message ");
539 sprintf(buff, "number=%ld severity=%ld ",
540 srvmsg->msgnumber, srvmsg->severity);
541 sv_catpv(DBIc_ERRSTR(imp_dbh), buff);
542 sprintf(buff, "state=%ld line=%ld",
543 srvmsg->state, srvmsg->line);
544 sv_catpv(DBIc_ERRSTR(imp_dbh), buff);
545 if (srvmsg->svrnlen> 0) {
546 sv_catpv(DBIc_ERRSTR(imp_dbh), " server=");
547 sv_catpv(DBIc_ERRSTR(imp_dbh), srvmsg->svrname);
548 }
549 if (srvmsg->proclen> 0) {
550 sv_catpv(DBIc_ERRSTR(imp_dbh), " procedure=");
551 sv_catpv(DBIc_ERRSTR(imp_dbh), srvmsg->proc);
552 }
553
554 sv_catpv(DBIc_ERRSTR(imp_dbh), " text=");
555 sv_catpv(DBIc_ERRSTR(imp_dbh), srvmsg->text);
556 if(imp_dbh->showSql) {
557 sv_catpv(DBIc_ERRSTR(imp_dbh), " Statement=");
558 sv_catpv(DBIc_ERRSTR(imp_dbh), imp_dbh->sql);
559 }
560 if (imp_dbh->showEed && srvmsg->status & CS_HASEED) {
561 sv_catpv(DBIc_ERRSTR(imp_dbh), "\n[Start Extended Error]\n");
562 if (ct_con_props(connection, CS_GET, CS_EED_CMD,
563 &cmd, CS_UNUSED, NULL) != CS_SUCCEED)
564 {
565 warn("servermsg_cb: ct_con_props(CS_EED_CMD) failed");
566 return CS_FAIL;
567 }
568 retcode = fetch_data(imp_dbh, cmd);
569 sv_catpv(DBIc_ERRSTR(imp_dbh), "\n[End Extended Error]\n");
570 }
571 else
572 retcode = CS_SUCCEED;
573
574 sv_catpv(DBIc_ERRSTR(imp_dbh), " ");
575
576 return retcode;
577 } else {
578 if(srvmsg->msgnumber) {
579 PerlIO_printf(DBIc_LOGPIO(imp_dbh), "Server message: number=%ld severity=%ld ",
580 srvmsg->msgnumber, srvmsg->severity);
581 PerlIO_printf(DBIc_LOGPIO(imp_dbh), "state=%ld line=%ld ",
582 srvmsg->state, srvmsg->line);
583 if (srvmsg->svrnlen> 0) {
584 PerlIO_printf(DBIc_LOGPIO(imp_dbh), "server=%s ", srvmsg->svrname);
585 }
586 if (srvmsg->proclen> 0) {
587 PerlIO_printf(DBIc_LOGPIO(imp_dbh), "procedure=%s ", srvmsg->proc);
588 }
589 PerlIO_printf(DBIc_LOGPIO(imp_dbh), "text=%s\n", srvmsg->text);
590 } else {
591 warn("%s\n", srvmsg->text);
592 }
593
594 PerlIO_flush(DBIc_LOGPIO(imp_dbh));
595 }
596
597 return CS_SUCCEED;
598 }
599
GetAggOp(CS_INT op)600 static CS_CHAR * GetAggOp(CS_INT op) {
601 CS_CHAR *name;
602
603 switch ((int) op) {
604 case CS_OP_SUM:
605 name = "sum";
606 break;
607 case CS_OP_AVG:
608 name = "avg";
609 break;
610 case CS_OP_COUNT:
611 name = "count";
612 break;
613 case CS_OP_MIN:
614 name = "min";
615 break;
616 case CS_OP_MAX:
617 name = "max";
618 break;
619 default:
620 name = "unknown";
621 break;
622 }
623 return name;
624 }
625
get_cwidth(CS_DATAFMT * column)626 static CS_INT get_cwidth(CS_DATAFMT *column) {
627 CS_INT len;
628
629 switch ((int) column->datatype) {
630 case CS_CHAR_TYPE:
631 case CS_LONGCHAR_TYPE:
632 case CS_VARCHAR_TYPE:
633 case CS_TEXT_TYPE:
634 case CS_IMAGE_TYPE:
635 len = column->maxlength;
636 break;
637
638 case CS_BINARY_TYPE:
639 case CS_VARBINARY_TYPE:
640 case CS_LONGBINARY_TYPE:
641 //#if defined(CS_UNICHAR_TYPE)
642 // case CS_UNICHAR_TYPE:
643 // case CS_UNITEXT_TYPE:
644 //#endif
645 len = (2 * column->maxlength) + 2;
646 break;
647
648 case CS_BIT_TYPE:
649 case CS_TINYINT_TYPE:
650 len = 3;
651 break;
652
653 case CS_SMALLINT_TYPE:
654 #if defined(CS_USMALLINT_TYPE)
655 case CS_USMALLINT_TYPE:
656 #endif
657 len = 6;
658 break;
659
660 case CS_INT_TYPE:
661 #if defined(CS_UINT_TYPE)
662 case CS_UINT_TYPE:
663 #endif
664 len = 11;
665 break;
666
667 #if defined(CS_BIGINT_TYPE)
668 case CS_BIGINT_TYPE:
669 case CS_UBIGINT_TYPE:
670 len = 22;
671 #endif
672
673 case CS_REAL_TYPE:
674 case CS_FLOAT_TYPE:
675 len = 20;
676 break;
677
678 case CS_MONEY_TYPE:
679 case CS_MONEY4_TYPE:
680 len = 24;
681 break;
682
683 case CS_DATETIME_TYPE:
684 case CS_DATETIME4_TYPE:
685 #if defined(CS_DATE_TYPE)
686 case CS_DATE_TYPE:
687 case CS_TIME_TYPE:
688 #endif
689 #if defined(CS_BIGDATETIME_TYPE)
690 case CS_BIGDATETIME_TYPE:
691 case CS_BIGTIME_TYPE:
692 #endif
693 len = 40;
694 break;
695
696 #ifdef CS_UNIQUE_TYPE
697 case CS_UNIQUE_TYPE:
698 len = 40;
699 break;
700 #endif
701
702 default:
703 len = column->maxlength;
704 break;
705 }
706
707 return len;
708 }
709
display_dlen(CS_DATAFMT * column)710 static CS_INT display_dlen(CS_DATAFMT *column) {
711 CS_INT len;
712
713 len = get_cwidth(column);
714
715 switch ((int) column->datatype) {
716 case CS_CHAR_TYPE:
717 case CS_LONGCHAR_TYPE:
718 case CS_VARCHAR_TYPE:
719 case CS_TEXT_TYPE:
720 case CS_IMAGE_TYPE:
721 case CS_BINARY_TYPE:
722 case CS_VARBINARY_TYPE:
723 len = MIN(len, MAX_CHAR_BUF);
724 break;
725 default:
726 break;
727 }
728
729 return MAX(strlen(column->name) + 1, len);
730 }
731
display_header(imp_dbh_t * imp_dbh,CS_INT numcols,CS_DATAFMT * columns)732 static CS_RETCODE display_header(imp_dbh_t *imp_dbh, CS_INT numcols,
733 CS_DATAFMT *columns) {
734 dTHX;
735 CS_INT i;
736 CS_INT l;
737 CS_INT j;
738 CS_INT disp_len;
739
740 sv_catpv(DBIc_ERRSTR(imp_dbh), "\n");
741 for (i = 0; i < numcols; i++) {
742 disp_len = display_dlen(&columns[i]);
743 sv_catpv(DBIc_ERRSTR(imp_dbh), columns[i].name);
744 l = disp_len - strlen(columns[i].name);
745 for (j = 0; j < l; j++) {
746 sv_catpv(DBIc_ERRSTR(imp_dbh), " ");
747 }
748 }
749 sv_catpv(DBIc_ERRSTR(imp_dbh), "\n");
750 for (i = 0; i < numcols; i++) {
751 disp_len = display_dlen(&columns[i]);
752 l = disp_len - 1;
753 for (j = 0; j < l; j++) {
754 sv_catpv(DBIc_ERRSTR(imp_dbh), "-");
755 }
756 sv_catpv(DBIc_ERRSTR(imp_dbh), " ");
757 }
758 sv_catpv(DBIc_ERRSTR(imp_dbh), "\n");
759
760 return CS_SUCCEED;
761 }
762
syb_init(dbistate_t * dbistate)763 void syb_init(dbistate_t *dbistate) {
764 dTHX;
765 SV *sv;
766 CS_INT netio_type = CS_SYNC_IO;
767 STRLEN lna;
768 CS_INT outlen;
769 CS_RETCODE retcode = CS_FAIL;
770 CS_INT cs_ver;
771 CS_INT boolean = CS_FALSE;
772
773 DBIS = dbistate;
774
775 #if PERL_VERSION >= 8 && defined(_REENTRANT)
776 MUTEX_INIT (context_alloc_mutex);
777 #endif
778
779 #if 0
780 /* Do signal handling stuff... */
781
782 /* Set up signal set with just SIGUSR1. */
783 sigemptyset(&set);
784 sigaddset(&set, SIGINT);
785 /* Block SIGINT */
786 sigprocmask(SIG_BLOCK, &set, NULL);
787 #endif
788
789 #if defined(CS_CURRENT_VERSION)
790 if (retcode != CS_SUCCEED) {
791 cs_ver = CS_CURRENT_VERSION;
792 retcode = cs_ctx_alloc(cs_ver, &context);
793 }
794 #endif
795
796 #if defined(CS_VERSION_150)
797 if (retcode != CS_SUCCEED) {
798 cs_ver = CS_VERSION_150;
799 retcode = cs_ctx_alloc(cs_ver, &context);
800 }
801 #endif
802 #if defined(CS_VERSION_125)
803 if (retcode != CS_SUCCEED) {
804 cs_ver = CS_VERSION_125;
805 retcode = cs_ctx_alloc(cs_ver, &context);
806 }
807 #endif
808 #if defined(CS_VERSION_120)
809 if (retcode != CS_SUCCEED) {
810 cs_ver = CS_VERSION_120;
811 retcode = cs_ctx_alloc(cs_ver, &context);
812 }
813 #endif
814 #if defined(CS_VERSION_110)
815 if (retcode != CS_SUCCEED) {
816 cs_ver = CS_VERSION_110;
817 retcode = cs_ctx_alloc(cs_ver, &context);
818 }
819 #endif
820
821 if (retcode != CS_SUCCEED) {
822 cs_ver = CS_VERSION_100;
823 retcode = cs_ctx_alloc(cs_ver, &context);
824 }
825
826 if (retcode != CS_SUCCEED)
827 croak("DBD::Sybase initialize: cs_ctx_alloc(%d) failed", cs_ver);
828
829 #if defined(CS_CURRENT_VERSION)
830 if (cs_ver = CS_CURRENT_VERSION)
831 BLK_VERSION = CS_CURRENT_VERSION;
832 #endif
833 #if defined(CS_VERSION_150)
834 if (cs_ver == CS_VERSION_150)
835 BLK_VERSION = BLK_VERSION_150;
836 #endif
837 #if defined(CS_VERSION_125)
838 if (cs_ver == CS_VERSION_125)
839 BLK_VERSION = BLK_VERSION_125;
840 #endif
841 #if defined(CS_VERSION_120)
842 if (cs_ver == CS_VERSION_120)
843 BLK_VERSION = BLK_VERSION_120;
844 #endif
845 #if defined(CS_VERSION_110)
846 if (cs_ver == CS_VERSION_110)
847 BLK_VERSION = BLK_VERSION_110;
848 #endif
849 if (cs_ver == CS_VERSION_100)
850 BLK_VERSION = BLK_VERSION_100;
851
852 #if USE_CSLIB_CB
853 if (cs_config(context, CS_SET, CS_MESSAGE_CB,
854 (CS_VOID *)cslibmsg_cb, CS_UNUSED, NULL) != CS_SUCCEED) {
855 /* Release the context structure. */
856
857 (void)cs_ctx_drop(context);
858 croak("DBD::Sybase initialize: cs_config(CS_MESSAGE_CB) failed");
859 }
860 #else
861 if (cs_diag(context, CS_INIT, CS_UNUSED, CS_UNUSED, NULL) != CS_SUCCEED)
862 warn("cs_diag(CS_INIT) failed");
863 #endif
864
865 #if defined(CS_EXTERNAL_CONFIG)
866 if (cs_config(context, CS_SET, CS_EXTERNAL_CONFIG, &boolean, CS_UNUSED,
867 NULL) != CS_SUCCEED) {
868 /* Ignore this error... */
869 /* warn("Can't set CS_EXTERNAL_CONFIG to false"); */
870 }
871 #endif
872
873 if ((retcode = ct_init(context, cs_ver)) != CS_SUCCEED) {
874 #if 1
875 cs_ctx_drop(context);
876 #endif
877 context = NULL;
878 croak("DBD::Sybase initialize: ct_init(%d) failed", cs_ver);
879 }
880
881 if ((retcode = ct_callback(context, NULL, CS_SET, CS_CLIENTMSG_CB,
882 (CS_VOID *) clientmsg_cb)) != CS_SUCCEED)
883 croak("DBD::Sybase initialize: ct_callback(clientmsg) failed");
884 if ((retcode = ct_callback(context, NULL, CS_SET, CS_SERVERMSG_CB,
885 (CS_VOID *) servermsg_cb)) != CS_SUCCEED)
886 croak("DBD::Sybase initialize: ct_callback(servermsg) failed");
887
888 if ((retcode = ct_config(context, CS_SET, CS_NETIO, &netio_type, CS_UNUSED,
889 NULL)) != CS_SUCCEED)
890 croak("DBD::Sybase initialize: ct_config(netio) failed");
891
892 #if defined(MAX_CONNECT)
893 netio_type = MAX_CONNECT;
894 if((retcode = ct_config(context, CS_SET, CS_MAX_CONNECT, &netio_type,
895 CS_UNUSED, NULL)) != CS_SUCCEED)
896 croak("DBD::Sybase initialize: ct_config(max_connect) failed");
897 #endif
898
899 {
900 char out[1024], *p;
901 retcode = ct_config(context, CS_GET, CS_VER_STRING, (CS_VOID*) out,
902 1024, &outlen);
903 if ((p = strchr(out, '\n')))
904 *p = 0;
905
906 ocVersion = my_strdup(out);
907 }
908
909 if ((sv = perl_get_sv("0", FALSE))) {
910 char *p;
911 strcpy(scriptName, SvPV(sv, lna));
912 if ((p = strrchr(scriptName, '/'))) {
913 char tmp[255];
914 ++p;
915 strncpy(tmp, p, 250);
916 strcpy(scriptName, tmp);
917 }
918 /* PR 506 */
919 if (!strcmp(scriptName, "-e")) {
920 strcpy(scriptName, "perl -e");
921 }
922 }
923 /* PR 506 - get hostname */
924 if ((sv = perl_get_sv("DBD::Sybase::hostname", FALSE))) {
925 strcpy(hostname, SvPV(sv, lna));
926 /*fprintf(stderr, "Got hostname: %s\n", hostname);*/
927 }
928
929 if (dbistate->debug >= 3) {
930 char *p = "";
931 if ((sv = perl_get_sv("DBD::Sybase::VERSION", FALSE)))
932 p = SvPV(sv, lna);
933
934 PerlIO_printf(dbistate->logfp,
935 " syb_init() -> DBD::Sybase %s initialized\n", p);
936 PerlIO_printf(dbistate->logfp, " OpenClient version: %s\n",
937 ocVersion);
938 }
939
940 if ((retcode = cs_loc_alloc(context, &locale)) != CS_SUCCEED) {
941 warn("cs_loc_alloc failed");
942 }
943 if (retcode == CS_SUCCEED) {
944 if ((retcode = cs_locale(context, CS_SET, locale, CS_LC_ALL,
945 (CS_CHAR*) NULL, CS_UNUSED, (CS_INT*) NULL)) != CS_SUCCEED) {
946 warn("cs_locale(CS_LC_ALL) failed");
947 }
948 }
949
950 /* Set default charset to utf8. The charset can still be overridden
951 * via the charset=xxxx connection attribute.
952 */
953 /* if (retcode == CS_SUCCEED) {
954 if ((retcode = cs_locale(context, CS_SET, locale, CS_SYB_CHARSET,
955 "utf8", CS_NULLTERM, NULL)) != CS_SUCCEED) {
956 warn("cs_locale(CS_SYB_CHARSET) failed");
957 }
958 }*/
959
960 if (retcode == CS_SUCCEED) {
961 CS_INT type = CS_DATES_SHORT;
962 if ((retcode = cs_dt_info(context, CS_SET, locale, CS_DT_CONVFMT,
963 CS_UNUSED, (CS_VOID*) &type, CS_SIZEOF(CS_INT), NULL))
964 != CS_SUCCEED)
965 warn("cs_dt_info() failed");
966 }
967
968 if (retcode == CS_SUCCEED) {
969 if ((retcode = cs_config(context, CS_SET, CS_LOC_PROP, locale,
970 CS_UNUSED, NULL)) != CS_SUCCEED) {
971 /* warn("cs_config(CS_LOC_PROP) failed"); */
972 }
973 }
974 }
975
syb_thread_enabled(void)976 int syb_thread_enabled(void) {
977 int retcode = 0;
978
979 #if PERL_VERSION >= 8 && defined(_REENTRANT) && !defined(NO_THREADS)
980 retcode = 1;
981 #endif
982
983 return retcode;
984 }
985
syb_set_timeout(int timeout)986 int syb_set_timeout(int timeout) {
987 dTHX;
988 CS_RETCODE retcode;
989 if (timeout <= 0)
990 timeout = CS_NO_LIMIT; /* set negative or 0 length timeout to
991 default no limit */
992
993 /* XXX: DBIS and DBILOGFP need to be fixed */
994 if (DBIS->debug >= 3)
995 PerlIO_printf(DBILOGFP,
996 " syb_set_timeout() -> ct_config(CS_TIMEOUT,%d)\n", timeout);
997
998 #if PERL_VERSION >= 8 && defined(_REENTRANT)
999 MUTEX_LOCK (context_alloc_mutex);
1000 #endif
1001
1002 if ((retcode = ct_config(context, CS_SET, CS_TIMEOUT, &timeout, CS_UNUSED,
1003 NULL)) != CS_SUCCEED)
1004 warn("ct_config(CS_SET, CS_TIMEOUT) failed");
1005
1006 #if PERL_VERSION >= 8 && defined(_REENTRANT)
1007 MUTEX_UNLOCK (context_alloc_mutex);
1008 #endif
1009
1010 return retcode;
1011 }
1012
extractFromDsn(char * tag,char * source,char * dest,int size)1013 static int extractFromDsn(char *tag, char *source, char *dest, int size) {
1014 char *p = strstr(source, tag);
1015 char *q = dest;
1016 if (!p)
1017 return 0;
1018 p += strlen(tag);
1019 while (p && *p && *p != ';' && --size)
1020 *q++ = *p++;
1021 *q = 0;
1022
1023 return 1;
1024 }
1025
fetchAttrib(SV * attribs,char * key)1026 static int fetchAttrib(SV *attribs, char *key) {
1027 dTHX;
1028 if (attribs) {
1029 SV **svp;
1030 if ((svp = hv_fetch((HV*) SvRV(attribs), key, strlen(key), 0)) != NULL) {
1031 return SvIV(*svp);
1032 }
1033 }
1034 return 0;
1035 }
1036
fetchSvAttrib(SV * attribs,char * key)1037 static SV * fetchSvAttrib(SV *attribs, char *key) {
1038 dTHX;
1039
1040 if (attribs) {
1041 SV **svp;
1042 if ((svp = hv_fetch((HV*) SvRV(attribs), key, strlen(key), 0)) != NULL) {
1043 return newSVsv(*svp);
1044 }
1045 }
1046 return NULL;
1047 }
1048
1049 /* side-effect: sets the BCP related flags in imp_sth */
getBcpAttribs(imp_sth_t * imp_sth,SV * attribs)1050 static void getBcpAttribs(imp_sth_t *imp_sth, SV *attribs) {
1051 dTHX;
1052 SV **svp;
1053 #define BCP_ATTRIB "syb_bcp_attribs"
1054 if (!attribs || !SvOK(attribs)) {
1055 return;
1056 }
1057 if ((svp = hv_fetch((HV*) SvRV(attribs), BCP_ATTRIB, strlen(BCP_ATTRIB), 0))
1058 != NULL) {
1059 imp_sth->bcpFlag = 1;
1060 imp_sth->bcpIdentityFlag = fetchAttrib(*svp, "identity_flag");
1061 imp_sth->bcpIdentityCol = fetchAttrib(*svp, "identity_column");
1062 }
1063 }
1064
syb_db_login(SV * dbh,imp_dbh_t * imp_dbh,char * dsn,char * uid,char * pwd,SV * attribs)1065 int syb_db_login(SV *dbh, imp_dbh_t *imp_dbh, char *dsn, char *uid, char *pwd,
1066 SV *attribs) {
1067 dTHX;
1068 int retval;
1069
1070 imp_dbh->server[0] = 0;
1071 imp_dbh->charset[0] = 0;
1072 imp_dbh->packetSize[0] = 0;
1073 imp_dbh->language[0] = 0;
1074 imp_dbh->ifile[0] = 0;
1075 imp_dbh->loginTimeout[0] = 0;
1076 imp_dbh->timeout[0] = 0;
1077 imp_dbh->hostname[0] = 0;
1078 imp_dbh->scriptName[0] = 0;
1079 imp_dbh->database[0] = 0;
1080 imp_dbh->curr_db[0] = 0;
1081 imp_dbh->encryptPassword[0] = 0;
1082 imp_dbh->showSql = 0;
1083 imp_dbh->showEed = 0;
1084 imp_dbh->flushFinish = FLUSH_FINISH;
1085 imp_dbh->doRealTran = NO_CHAINED_TRAN; /* default to use chained transaction mode */
1086 imp_dbh->chainedSupported = 1;
1087 imp_dbh->quotedIdentifier = 0;
1088 imp_dbh->rowcount = 0;
1089 imp_dbh->doProcStatus = PROC_STATUS;
1090 imp_dbh->useBin0x = 0;
1091 imp_dbh->binaryImage = 0;
1092 imp_dbh->deadlockRetry = 0;
1093 imp_dbh->deadlockSleep = 0;
1094 imp_dbh->deadlockVerbose = 0;
1095 imp_dbh->nsqlNoStatus = 0;
1096 imp_dbh->noChildCon = 0;
1097 imp_dbh->failedDbUseFatal = fetchAttrib(attribs, "syb_failed_db_fatal");
1098 imp_dbh->bindEmptyStringNull = fetchAttrib(attribs,
1099 "syb_bind_empty_string_as_null");
1100 imp_dbh->err_handler = fetchSvAttrib(attribs, "syb_err_handler");
1101 imp_dbh->alwaysForceFailure = 1;
1102 imp_dbh->kerberosPrincipal[0] = 0;
1103 imp_dbh->kerbGetTicket = fetchSvAttrib(attribs,
1104 "syb_kerberos_serverprincipal");
1105 imp_dbh->disconnectInChild
1106 = fetchAttrib(attribs, "syb_disconnect_in_child");
1107 imp_dbh->host[0] = 0;
1108 imp_dbh->port[0] = 0;
1109 imp_dbh->enable_utf8 = fetchAttrib(attribs, "syb_enable_utf8");
1110 #if !defined(DBD_CAN_HANDLE_UTF8)
1111 if (imp_dbh->enable_utf8) {
1112 warn("The current version of OpenClient can't handle utf8 data.");
1113 }
1114 imp_dbh->enable_utf8 = 0;
1115 #endif
1116
1117
1118 imp_dbh->blkLogin[0] = 0;
1119
1120 imp_dbh->dateFmt = 0;
1121 imp_dbh->inUse = 0;
1122 imp_dbh->init_done = 0;
1123
1124 if (strchr(dsn, '=')) {
1125 extractFromDsn("server=", dsn, imp_dbh->server, 64);
1126 extractFromDsn("charset=", dsn, imp_dbh->charset, 64);
1127 extractFromDsn("database=", dsn, imp_dbh->database, 260);
1128 extractFromDsn("packetSize=", dsn, imp_dbh->packetSize, 64);
1129 extractFromDsn("language=", dsn, imp_dbh->language, 64);
1130 extractFromDsn("interfaces=", dsn, imp_dbh->ifile, 255);
1131 extractFromDsn("loginTimeout=", dsn, imp_dbh->loginTimeout, 64);
1132 extractFromDsn("timeout=", dsn, imp_dbh->timeout, 64);
1133 extractFromDsn("scriptName=", dsn, imp_dbh->scriptName, 255);
1134 extractFromDsn("hostname=", dsn, imp_dbh->hostname, 255);
1135 extractFromDsn("tdsLevel=", dsn, imp_dbh->tdsLevel, 30);
1136 extractFromDsn("encryptPassword=", dsn, imp_dbh->encryptPassword, 10);
1137 extractFromDsn("kerberos=", dsn, imp_dbh->kerberosPrincipal, 255);
1138 extractFromDsn("host=", dsn, imp_dbh->host, 64);
1139 extractFromDsn("port=", dsn, imp_dbh->port, 20);
1140 extractFromDsn("maxConnect=", dsn, imp_dbh->maxConnect, 25);
1141 extractFromDsn("sslCAFile=", dsn, imp_dbh->sslCAFile, 255);
1142 extractFromDsn("bulkLogin=", dsn, imp_dbh->blkLogin, 10);
1143 extractFromDsn("tds_keepalive=", dsn, imp_dbh->tds_keepalive, 10);
1144 extractFromDsn("serverType=", dsn, imp_dbh->serverType, 30);
1145 } else {
1146 strncpy(imp_dbh->server, dsn, 64);
1147 imp_dbh->server[63] = 0;
1148 }
1149
1150 strncpy(imp_dbh->uid, uid, 32);
1151 imp_dbh->uid[31] = 0;
1152 strncpy(imp_dbh->pwd, pwd, 32);
1153 imp_dbh->pwd[31] = 0;
1154
1155 sv_setpv(DBIc_ERRSTR(imp_dbh), "");
1156
1157 if (imp_dbh->kerbGetTicket) {
1158 fetchKerbTicket(imp_dbh);
1159 }
1160
1161 imp_dbh->pid = getpid();
1162
1163 #if PERL_VERSION >= 8 && defined(_REENTRANT)
1164 MUTEX_LOCK(context_alloc_mutex);
1165 #endif
1166
1167 if ((imp_dbh->connection = syb_db_connect(imp_dbh)) == NULL)
1168 retval = 0;
1169 else
1170 retval = 1;
1171
1172 #if PERL_VERSION >= 8 && defined(_REENTRANT)
1173 MUTEX_UNLOCK(context_alloc_mutex);
1174 #endif
1175
1176 if (!retval)
1177 return retval;
1178
1179 if (!imp_dbh->serverType[0] || !strncasecmp(imp_dbh->serverType, "ase", 3))
1180 get_server_version(dbh, imp_dbh, imp_dbh->connection);
1181
1182 DBIc_IMPSET_on(imp_dbh); /* imp_dbh set up now */
1183 DBIc_ACTIVE_on(imp_dbh); /* call disconnect before freeing*/
1184
1185 DBIc_LongReadLen(imp_dbh) = 32768;
1186
1187 return 1;
1188 }
1189
syb_db_connect(imp_dbh_t * imp_dbh)1190 static CS_CONNECTION *syb_db_connect(imp_dbh_t *imp_dbh) {
1191 dTHR;
1192 CS_RETCODE retcode;
1193 CS_CONNECTION *connection = NULL;
1194 CS_LOCALE *locale = NULL;
1195 char ofile[255];
1196 int len;
1197
1198 /* Allow increase of the max number of connections - patch supplied by
1199 Ed Avis */
1200 if (imp_dbh->maxConnect[0]) {
1201 /* Maximum number of connections. */
1202 const char * const s = imp_dbh->maxConnect;
1203 int i;
1204
1205 i = atoi(s);
1206 if (i < 1) {
1207 warn("maxConnect must be positive, not '%s'", s);
1208 return 0;
1209 }
1210 #if defined(CS_MAX_CONNECT)
1211 if ((retcode = ct_config(context, CS_SET, CS_MAX_CONNECT,
1212 (CS_VOID*) &i, CS_UNUSED, NULL)) != CS_SUCCEED)
1213 croak("ct_config(max_connect) failed");
1214 #else
1215 warn("ct_config(max_connect) not supported");
1216 #endif
1217 }
1218 if (imp_dbh->ifile[0]) {
1219 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1220 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
1221 " syb_db_login() -> ct_config(CS_IFILE,%s)\n",
1222 imp_dbh->ifile);
1223 if ((retcode = ct_config(context, CS_GET, CS_IFILE, ofile, 255, NULL))
1224 != CS_SUCCEED)
1225 warn("ct_config(CS_GET, CS_IFILE) failed");
1226 if (retcode == CS_SUCCEED) {
1227 if ((retcode = ct_config(context, CS_SET, CS_IFILE, imp_dbh->ifile,
1228 CS_NULLTERM, NULL)) != CS_SUCCEED) {
1229 warn("ct_config(CS_SET, CS_IFILE, %s) failed", imp_dbh->ifile);
1230 return NULL;
1231 }
1232 }
1233 }
1234 if (imp_dbh->loginTimeout[0]) {
1235 int timeout = atoi(imp_dbh->loginTimeout);
1236 if (timeout <= 0)
1237 timeout = 60; /* set negative or 0 length timeout to
1238 default 60 seconds */
1239 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1240 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
1241 " syb_db_login() -> ct_config(CS_LOGIN_TIMEOUT,%d)\n",
1242 timeout);
1243 if ((retcode = ct_config(context, CS_SET, CS_LOGIN_TIMEOUT, &timeout,
1244 CS_UNUSED, NULL)) != CS_SUCCEED)
1245 warn("ct_config(CS_SET, CS_LOGIN_TIMEOUT) failed");
1246 }
1247 if (imp_dbh->timeout[0]) {
1248 int timeout = atoi(imp_dbh->timeout);
1249 if (timeout <= 0)
1250 timeout = CS_NO_LIMIT; /* set negative or 0 length timeout to
1251 default no limit */
1252 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1253 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
1254 " syb_db_login() -> ct_config(CS_TIMEOUT,%d)\n", timeout);
1255 if ((retcode = ct_config(context, CS_SET, CS_TIMEOUT, &timeout,
1256 CS_UNUSED, NULL)) != CS_SUCCEED)
1257 warn("ct_config(CS_SET, CS_TIMEOUT) failed");
1258 }
1259
1260 if (imp_dbh->language[0] != 0 || imp_dbh->charset[0] != 0) {
1261 CS_INT type = CS_DATES_SHORT;
1262
1263 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1264 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
1265 " syb_db_login() -> using private CS_LOCALE data\n");
1266 /* Set up the proper locale - to handle character sets, etc. */
1267 if ((retcode = cs_loc_alloc(context, &imp_dbh->locale) != CS_SUCCEED)) {
1268 warn("cs_loc_alloc failed");
1269 return 0;
1270 }
1271 if (cs_locale(context, CS_SET, imp_dbh->locale, CS_LC_ALL,
1272 (CS_CHAR*) NULL, CS_UNUSED, (CS_INT*) NULL) != CS_SUCCEED) {
1273 warn("cs_locale(CS_LC_ALL) failed");
1274 return 0;
1275 }
1276 if (imp_dbh->language[0] != 0) {
1277 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1278 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
1279 " syb_db_login() -> cs_locale(CS_SYB_LANG,%s)\n",
1280 imp_dbh->language);
1281 if (cs_locale(context, CS_SET, imp_dbh->locale, CS_SYB_LANG,
1282 (CS_CHAR*) imp_dbh->language, CS_NULLTERM, (CS_INT*) NULL)
1283 != CS_SUCCEED) {
1284 warn("cs_locale(CS_SYB_LANG, %s) failed", imp_dbh->language);
1285 return 0;
1286 }
1287 }
1288 if (imp_dbh->charset[0] != 0) {
1289 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1290 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
1291 " syb_db_login() -> cs_locale(CS_SYB_CHARSET,%s)\n",
1292 imp_dbh->charset);
1293 if (cs_locale(context, CS_SET, imp_dbh->locale, CS_SYB_CHARSET,
1294 (CS_CHAR*) imp_dbh->charset, CS_NULLTERM, (CS_INT*) NULL)
1295 != CS_SUCCEED) {
1296 warn("cs_locale(CS_SYB_CHARSET, %s) failed", imp_dbh->charset);
1297 return 0;
1298 }
1299 }
1300
1301 if (cs_dt_info(context, CS_SET, imp_dbh->locale, CS_DT_CONVFMT,
1302 CS_UNUSED, (CS_VOID*) &type, CS_SIZEOF(CS_INT), NULL)
1303 != CS_SUCCEED)
1304 warn("cs_dt_info() failed");
1305
1306 } else {
1307 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1308 PerlIO_printf(DBIc_LOGPIO(imp_dbh)," syb_db_login() -> using global CS_LOCALE data\n");
1309 }
1310
1311 #if defined(CS_CON_KEEPALIVE)
1312 if (imp_dbh->tds_keepalive[0]) {
1313 int tds_keepalive = atoi(imp_dbh->tds_keepalive);
1314
1315 if (tds_keepalive != 1) {
1316 tds_keepalive = 0;
1317 }
1318
1319 if(DBIc_DBISTATE(imp_dbh)->debug >= 3)
1320 PerlIO_printf(DBIc_LOGPIO(imp_dbh), "syb_db_login() -> ct_config(CS_CON_KEEPALIVE,%d)\n", tds_keepalive);
1321
1322 if((retcode = ct_config(context, CS_SET, CS_CON_KEEPALIVE, &tds_keepalive, CS_UNUSED, NULL)) != CS_SUCCEED)
1323 warn("ct_config(CS_SET, CS_CON_KEEPALIVE) failed");
1324 }
1325 #endif
1326
1327 if ((retcode = ct_con_alloc(context, &connection)) != CS_SUCCEED) {
1328 warn("ct_con_alloc failed");
1329 return 0;
1330 }
1331
1332 if (imp_dbh->locale) {
1333 if (ct_con_props(connection, CS_SET, CS_LOC_PROP,
1334 (CS_VOID*)imp_dbh->locale, CS_UNUSED, (CS_INT*)NULL)
1335 != CS_SUCCEED) {
1336
1337 warn("ct_con_props(CS_LOC_PROP) failed");
1338 return 0;
1339 }
1340 }
1341
1342 if ((retcode = ct_con_props(connection, CS_SET, CS_USERDATA, &imp_dbh,
1343 CS_SIZEOF(imp_dbh), NULL)) != CS_SUCCEED) {
1344 warn("ct_con_props(CS_USERDATA) failed");
1345 return 0;
1346 }
1347 if (imp_dbh->tdsLevel[0] != 0) {
1348 CS_INT value = 0;
1349 if (strEQ(imp_dbh->tdsLevel, "CS_TDS_40"))
1350 value = CS_TDS_40;
1351 else if (strEQ(imp_dbh->tdsLevel, "CS_TDS_42"))
1352 value = CS_TDS_42;
1353 else if (strEQ(imp_dbh->tdsLevel, "CS_TDS_46"))
1354 value = CS_TDS_46;
1355 else if (strEQ(imp_dbh->tdsLevel, "CS_TDS_495"))
1356 value = CS_TDS_495;
1357 else if (strEQ(imp_dbh->tdsLevel, "CS_TDS_50"))
1358 value = CS_TDS_50;
1359
1360 if (value) {
1361 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1362 PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_login() -> ct_con_props(CS_TDS_VERSION,%s)\n", imp_dbh->tdsLevel);
1363
1364 if (ct_con_props(connection, CS_SET, CS_TDS_VERSION,
1365 (CS_VOID*)&value, CS_UNUSED, (CS_INT*)NULL) != CS_SUCCEED) {
1366 warn("ct_con_props(CS_TDS_VERSION, %s) failed",
1367 imp_dbh->tdsLevel);
1368 }
1369 } else {
1370 warn("Unkown tdsLevel value %s found", imp_dbh->tdsLevel);
1371 }
1372 }
1373
1374 if (imp_dbh->packetSize[0] != 0) {
1375 int i = atoi(imp_dbh->packetSize);
1376 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1377 PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_login() -> ct_con_props(CS_PACKETSIZE,%d)\n", i);
1378 if (ct_con_props(connection, CS_SET, CS_PACKETSIZE, (CS_VOID*)&i,
1379 CS_UNUSED, (CS_INT*)NULL) != CS_SUCCEED) {
1380 warn("ct_con_props(CS_PACKETSIZE, %d) failed", i);
1381 return 0;
1382 }
1383 }
1384
1385 #if defined(CS_SEC_NETWORKAUTH)
1386 if(imp_dbh->kerberosPrincipal[0] == 0) {
1387 #endif
1388 if (retcode == CS_SUCCEED && *imp_dbh->uid) {
1389 if ((retcode = ct_con_props(connection, CS_SET, CS_USERNAME,
1390 imp_dbh->uid, CS_NULLTERM, NULL)) != CS_SUCCEED) {
1391 warn("ct_con_props(CS_USERNAME) failed");
1392 return 0;
1393 }
1394 }
1395 if (retcode == CS_SUCCEED && *imp_dbh->pwd) {
1396 if ((retcode = ct_con_props(connection, CS_SET, CS_PASSWORD,
1397 imp_dbh->pwd, CS_NULLTERM, NULL)) != CS_SUCCEED) {
1398 warn("ct_con_props(CS_PASSWORD) failed");
1399 return 0;
1400 }
1401 }
1402 #if defined(CS_SEC_NETWORKAUTH)
1403 } else {
1404 /*
1405 ** If we're using Kerberos, set the appropriate connection properties
1406 ** (which requires the Sybase Kerberos principal name).
1407 */
1408 CS_INT i = CS_TRUE;
1409 if(DBIc_DBISTATE(imp_dbh)->debug >= 3)
1410 PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_login() -> ct_con_props(CS_SERVERPRINCIPAL,%s)\n",
1411 imp_dbh->kerberosPrincipal);
1412 /*warn( imp_dbh->kerberosPrincipal);*/
1413 if ((retcode = ct_con_props(connection, CS_SET, CS_SEC_NETWORKAUTH,
1414 (CS_VOID *) &i, CS_UNUSED, NULL)) != CS_SUCCEED)
1415 {
1416 warn("ct_con_props(CS_SEC_NETWORKAUTH) failed");
1417 return 0;
1418 }
1419
1420 if ((retcode = ct_con_props(connection, CS_SET, CS_SEC_SERVERPRINCIPAL,
1421 imp_dbh->kerberosPrincipal, CS_NULLTERM, NULL)) != CS_SUCCEED)
1422 {
1423 warn("ct_con_props(CS_SEC_SERVERPRINCIPAL) failed");
1424 return 0;
1425 }
1426 }
1427 #endif
1428 if (retcode == CS_SUCCEED) {
1429 if ((retcode = ct_con_props(connection, CS_SET, CS_APPNAME,
1430 *imp_dbh->scriptName ? imp_dbh->scriptName : scriptName,
1431 CS_NULLTERM, NULL)) != CS_SUCCEED) {
1432 warn("ct_con_props(CS_APPNAME, %s) failed", imp_dbh->scriptName);
1433 return 0;
1434 }
1435 if ((retcode = ct_con_props(connection, CS_SET, CS_HOSTNAME,
1436 *imp_dbh->hostname ? imp_dbh->hostname : hostname, CS_NULLTERM,
1437 NULL)) != CS_SUCCEED) {
1438 warn("ct_con_props(CS_HOSTNAME, %s) failed", imp_dbh->hostname);
1439 return 0;
1440 }
1441 }
1442 if (retcode == CS_SUCCEED) {
1443 if (imp_dbh->encryptPassword[0] != 0) {
1444 int i = CS_TRUE;
1445 if ((retcode = ct_con_props(connection, CS_SET, CS_SEC_ENCRYPTION,
1446 (CS_VOID*)&i, CS_UNUSED, (CS_INT*)NULL)) != CS_SUCCEED) {
1447 warn("ct_con_props(CS_SEC_ENCRYPTION, true) failed");
1448 return 0;
1449 }
1450 }
1451 }
1452 #if defined(CS_PROP_SSL_CA)
1453 if(retcode == CS_SUCCEED)
1454 {
1455 if(imp_dbh->sslCAFile[0] != 0) {
1456 if((retcode = ct_con_props(connection, CS_SET, CS_PROP_SSL_CA,
1457 imp_dbh->sslCAFile,
1458 CS_NULLTERM, (CS_INT*)NULL)) != CS_SUCCEED)
1459 {
1460 warn("ct_con_props(CS_PROP_SSL_CA, %s) failed", imp_dbh->sslCAFile);
1461 return 0;
1462 }
1463 }
1464 }
1465 #endif
1466
1467 if (retcode == CS_SUCCEED && imp_dbh->host[0] && imp_dbh->port[0]) {
1468 #if defined(CS_SERVERADDR)
1469 char buff[255];
1470 sprintf(buff, "%.64s %.20s", imp_dbh->host, imp_dbh->port);
1471 if((retcode = ct_con_props(connection, CS_SET, CS_SERVERADDR,
1472 (CS_VOID*)buff,
1473 CS_NULLTERM, (CS_INT*)NULL)) != CS_SUCCEED)
1474 {
1475 warn("ct_con_props(CS_SERVERADDR) failed");
1476 return 0;
1477 }
1478 #else
1479 croak("This version of OpenClient doesn't support CS_SERVERADDR");
1480 #endif
1481 }
1482
1483 if (retcode == CS_SUCCEED && imp_dbh->blkLogin[0] != 0) {
1484 CS_INT flag = CS_TRUE;
1485 if ((retcode = ct_con_props(connection, CS_SET, CS_BULK_LOGIN,
1486 (CS_VOID*)&flag, CS_UNUSED, (CS_INT*)NULL)) != CS_SUCCEED) {
1487 warn("ct_con_props(CS_BULK_LOGIN) failed");
1488 return 0;
1489 }
1490 }
1491
1492 if (retcode == CS_SUCCEED) {
1493 len = *imp_dbh->server == 0 ? 0 : CS_NULLTERM;
1494 if ((retcode = ct_connect(connection, imp_dbh->server, len))
1495 != CS_SUCCEED) {
1496 if (locale != NULL)
1497 cs_loc_drop(context, locale);
1498 ct_con_drop(connection);
1499 return 0;
1500 }
1501 }
1502 if (imp_dbh->ifile[0]) {
1503 if ((retcode = ct_config(context, CS_SET, CS_IFILE, ofile, CS_NULLTERM,
1504 NULL)) != CS_SUCCEED)
1505 warn("ct_config(CS_SET, CS_IFILE, %s) failed", ofile);
1506 }
1507
1508 if (imp_dbh->database[0] || imp_dbh->curr_db[0]) {
1509 int ret = syb_db_use(imp_dbh, connection);
1510 if (imp_dbh->failedDbUseFatal && ret < 0) {
1511 /* cleanup, and return NULL */
1512 ct_close(connection, CS_FORCE_CLOSE);
1513 if (locale != NULL)
1514 cs_loc_drop(context, locale);
1515 ct_con_drop(connection);
1516
1517 return 0;
1518 }
1519 }
1520
1521 if (imp_dbh->chainedSupported) {
1522 CS_BOOL value = CS_FALSE;
1523
1524 /* Default to ct_option supported... */
1525 imp_dbh->optSupported = 1;
1526
1527 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1528 PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_login() -> checking for chained transactions\n");
1529 retcode = ct_options(connection, CS_SET, CS_OPT_CHAINXACTS, &value,
1530 CS_UNUSED, NULL);
1531 if (retcode == CS_FAIL) {
1532 imp_dbh->doRealTran = 1;
1533 imp_dbh->chainedSupported = 0;
1534 }
1535 #if 0
1536 /* This appears not to work - and hides the assignement to
1537 optSupported done in the server callback */
1538
1539 /* No SRV_OPTION handler on the server... */
1540 if (imp_dbh->lasterr == 17001)
1541 imp_dbh->optSupported = 0;
1542 else
1543 imp_dbh->optSupported = 1;
1544 #endif
1545 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1546 PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_login() -> ct_option is %ssupported\n", imp_dbh->optSupported == 1 ?"":"not ");
1547 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1548 PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_db_login() -> chained transactions are %s supported\n", retcode == CS_FAIL ? "not" : "");
1549 }
1550
1551 #if 0
1552 if(!imp_dbh->optSupported) {
1553 imp_dbh->chainedSupported = 0;
1554 imp_dbh->doRealTran = 1; /* XXX ??? */
1555 }
1556 #endif
1557
1558 if (imp_dbh->connection) {
1559 /* we're setting a sub-connection, so make sure that any attributes
1560 such as syb_quoted_identifier and syb_rowcount are set here too */
1561
1562 if (imp_dbh->quotedIdentifier && imp_dbh->optSupported) {
1563 CS_INT value = 1;
1564 retcode = ct_options(connection, CS_SET, CS_OPT_QUOTED_IDENT,
1565 &value, CS_UNUSED, NULL);
1566 if (retcode != CS_SUCCEED) {
1567 warn("Setting of CS_OPT_QUOTED_IDENT failed.");
1568 }
1569 }
1570 #if defined(CS_OPT_ROWCOUNT)
1571 if(imp_dbh->rowcount && imp_dbh->optSupported) {
1572 CS_INT value = imp_dbh->rowcount;
1573 retcode = ct_options(connection, CS_SET, CS_OPT_ROWCOUNT,
1574 &value, CS_UNUSED, NULL);
1575 if(retcode != CS_SUCCEED) {
1576 warn("Setting of CS_OPT_ROWCOUNT failed.");
1577 }
1578 }
1579 #endif
1580 }
1581
1582 return connection;
1583 }
1584
syb_db_use(imp_dbh_t * imp_dbh,CS_CONNECTION * connection)1585 static int syb_db_use(imp_dbh_t *imp_dbh, CS_CONNECTION *connection) {
1586 CS_COMMAND *cmd = syb_alloc_cmd(imp_dbh, connection);
1587 CS_RETCODE ret;
1588 CS_INT restype;
1589 char statement[255];
1590 int retval = 0;
1591 char *db;
1592
1593 if (!cmd)
1594 return -1;
1595
1596 if (DBIc_ACTIVE(imp_dbh) && imp_dbh->curr_db[0])
1597 db = imp_dbh->curr_db;
1598 else
1599 db = imp_dbh->database;
1600
1601 sprintf(statement, "use [%s]", db);
1602
1603 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1604 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
1605 " syb_db_use() -> ct_command(%s)\n", statement);
1606 ret = ct_command(cmd, CS_LANG_CMD, statement, CS_NULLTERM, CS_UNUSED);
1607 if (ret != CS_SUCCEED) {
1608 warn("ct_command failed for '%s'", statement);
1609 return -1;
1610 }
1611 ret = ct_send(cmd);
1612 if (ret != CS_SUCCEED) {
1613 warn("ct_send failed for '%s'", statement);
1614 return -1;
1615 }
1616 while ((ret = ct_results(cmd, &restype)) == CS_SUCCEED) {
1617 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1618 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
1619 " syb_db_use() -> ct_results(%d)\n", restype);
1620 if (restype == CS_CMD_FAIL) {
1621 warn("DBD::Sybase - can't change context to database %s\n",
1622 imp_dbh->database);
1623 retval = -1;
1624 }
1625 }
1626 ct_cmd_drop(cmd);
1627
1628 return retval;
1629 }
1630
extract_version(char * buff,char * ver)1631 static int extract_version(char *buff, char *ver) {
1632 if (!strncmp(buff, "Adaptive", 8) || !strncmp(buff, "SQL Server", 10)) {
1633 char *p, *s;
1634 if ((p = strchr(buff, '/'))) {
1635 ++p;
1636 if ((s = strchr(p, '/'))) {
1637 int len = s - p;
1638 if (len >= VERSION_SIZE) {
1639 len = VERSION_SIZE;
1640 }
1641 strncpy(ver, p, len);
1642 } else {
1643 strncpy(ver, p, 10);
1644 }
1645 }
1646 } else {
1647 strcpy(ver, "Unknown");
1648 }
1649
1650 return 0;
1651 }
1652
get_server_version(SV * dbh,imp_dbh_t * imp_dbh,CS_CONNECTION * con)1653 static int get_server_version(SV *dbh, imp_dbh_t *imp_dbh, CS_CONNECTION *con) {
1654 CS_COMMAND *cmd = syb_alloc_cmd(imp_dbh, con);
1655 CS_RETCODE ret;
1656 CS_INT restype;
1657 char statement[60];
1658 char buff[255];
1659 char version[sizeof(imp_dbh->serverVersion)];
1660 int retval = 0;
1661 char *db;
1662
1663 if (!cmd)
1664 return -1;
1665
1666 memset(version, 0, sizeof(imp_dbh->serverVersion));
1667
1668 sprintf(statement, "select @@version");
1669
1670 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1671 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
1672 " get_server_version() -> ct_command(%s)\n", statement);
1673 ret = ct_command(cmd, CS_LANG_CMD, statement, CS_NULLTERM, CS_UNUSED);
1674 if (ret != CS_SUCCEED) {
1675 warn("ct_command failed for '%s'", statement);
1676 return -1;
1677 }
1678 ret = ct_send(cmd);
1679 if (ret != CS_SUCCEED) {
1680 warn("ct_send failed for '%s'", statement);
1681 return -1;
1682 }
1683 while ((ret = ct_results(cmd, &restype)) == CS_SUCCEED) {
1684 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1685 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
1686 " get_server_version() -> ct_results(%d)\n", restype);
1687 if (restype == CS_CMD_FAIL) {
1688 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1689 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
1690 " get_server_version() -> Can't get version value\n");
1691 retval = -1;
1692 }
1693 if (restype == CS_ROW_RESULT) {
1694 CS_DATAFMT datafmt;
1695 CS_INT len;
1696 CS_SMALLINT indicator;
1697 CS_INT retcode;
1698 CS_INT rows;
1699
1700 ct_describe(cmd, 1, &datafmt);
1701 datafmt.format = CS_FMT_NULLTERM;
1702 datafmt.maxlength = sizeof(buff);
1703 ct_bind(cmd, 1, &datafmt, buff, &len, &indicator);
1704 while ((retcode = ct_fetch(cmd, CS_UNUSED, CS_UNUSED, CS_UNUSED,
1705 &rows)) == CS_SUCCEED) {
1706 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1707 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
1708 " get_server_version() -> version = %s\n", buff);
1709 strncpy(imp_dbh->serverVersionString, buff,
1710 sizeof(imp_dbh->serverVersionString));
1711 extract_version(buff, version);
1712 strncpy(imp_dbh->serverVersion, version,
1713 sizeof(imp_dbh->serverVersion));
1714 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1715 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
1716 " get_server_version() -> version = %s\n",
1717 imp_dbh->serverVersion);
1718 }
1719 }
1720
1721 }
1722 ct_cmd_drop(cmd);
1723
1724 return retval;
1725 }
1726
syb_ping(SV * dbh,imp_dbh_t * imp_dbh)1727 int syb_ping(SV *dbh, imp_dbh_t *imp_dbh) {
1728 dTHX;
1729 CS_COMMAND *cmd;
1730 CS_RETCODE ret;
1731 CS_INT restype;
1732 char *statement = "/* ping */";
1733
1734 if (DBIc_ACTIVE_KIDS(imp_dbh)) {
1735 DBIh_SET_ERR_CHAR(dbh, (imp_xxh_t *)imp_dbh, NULL, -1,
1736 "Can't call ping() with active statement handles",
1737 NULL, NULL);
1738 return -1;
1739 }
1740
1741 DBIh_CLEAR_ERROR(imp_dbh);
1742
1743 cmd = syb_alloc_cmd(imp_dbh, imp_dbh->connection);
1744
1745 if (!cmd)
1746 return 0;
1747
1748 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1749 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
1750 " syb_ping() -> ct_command(%s)\n", statement);
1751 ret = ct_command(cmd, CS_LANG_CMD, statement, CS_NULLTERM, CS_UNUSED);
1752 if (ret != CS_SUCCEED) {
1753 ct_cmd_drop(cmd);
1754 return 0;
1755 }
1756 ret = ct_send(cmd);
1757 if (ret != CS_SUCCEED) {
1758 ct_cmd_drop(cmd);
1759 return 0;
1760 }
1761 while ((ret = ct_results(cmd, &restype)) == CS_SUCCEED) {
1762 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1763 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
1764 " syb_ping() -> ct_results(%d)\n", restype);
1765 if (imp_dbh->isDead) {
1766 ct_cmd_drop(cmd);
1767 return 0;
1768 }
1769 /* Ignored - we don't care if there is a syntax error - only that
1770 the communication with the server worked */
1771 }
1772 DBIh_CLEAR_ERROR(imp_dbh);
1773
1774 ct_cmd_drop(cmd);
1775
1776 return 1;
1777 }
1778
syb_db_date_fmt(SV * dbh,imp_dbh_t * imp_dbh,char * fmt)1779 int syb_db_date_fmt(SV *dbh, imp_dbh_t *imp_dbh, char *fmt) {
1780 CS_INT type;
1781
1782 if (!strncmp(fmt, "ISO_strict", 10)) {
1783 imp_dbh->dateFmt = 2;
1784 return 1;
1785 }
1786 if (!strcmp(fmt, "ISO")) {
1787 imp_dbh->dateFmt = 1;
1788 return 1;
1789 }
1790
1791 imp_dbh->dateFmt = 0;
1792
1793 if (!strcmp(fmt, "LONG")) {
1794 type = CS_DATES_LONG;
1795 } else if (!strcmp(fmt, "SHORT")) {
1796 type = CS_DATES_SHORT;
1797 } else if (!strcmp(fmt, "DMY4_YYYY")) {
1798 type = CS_DATES_DMY4_YYYY;
1799 } else if (!strcmp(fmt, "MDY1_YYYY")) {
1800 type = CS_DATES_MDY1_YYYY;
1801 } else if (!strcmp(fmt, "DMY1_YYYY")) {
1802 type = CS_DATES_DMY1_YYYY;
1803 } else if (!strcmp(fmt, "DMY2_YYYY")) {
1804 type = CS_DATES_DMY2_YYYY;
1805 } else if (!strcmp(fmt, "YMD3_YYYY")) {
1806 type = CS_DATES_YMD3_YYYY;
1807 } else if (!strcmp(fmt, "HMS")) {
1808 type = CS_DATES_HMS;
1809 } else if (!strcmp(fmt, "LONGMS")) {
1810 #if defined(CS_DATES_LONGUSA_YYYY)
1811 type = CS_DATES_LONGUSA_YYYY;
1812 #else
1813 type = CS_DATES_LONG;
1814 #endif
1815 } else {
1816 warn("Invalid format %s in _date_fmt", fmt);
1817 return 0;
1818 }
1819 if (cs_dt_info(context, CS_SET, LOCALE(imp_dbh), CS_DT_CONVFMT, CS_UNUSED,
1820 (CS_VOID*) &type, CS_SIZEOF(CS_INT), NULL) != CS_SUCCEED) {
1821 warn("cs_dt_info() failed");
1822
1823 return 0;
1824 }
1825
1826 return 1;
1827 }
1828
syb_get_date_fmt(imp_dbh_t * imp_dbh,char * fmt)1829 static int syb_get_date_fmt(imp_dbh_t *imp_dbh, char *fmt) {
1830 CS_INT type;
1831 char *p;
1832
1833 if (imp_dbh->dateFmt == 2) {
1834 strcpy(fmt, "ISO_strict");
1835 return 1;
1836 }
1837 if (imp_dbh->dateFmt == 1) {
1838 strcpy(fmt, "ISO");
1839 return 1;
1840 }
1841
1842 if (cs_dt_info(context, CS_GET, LOCALE(imp_dbh), CS_DT_CONVFMT, CS_UNUSED,
1843 (CS_VOID*) &type, CS_SIZEOF(CS_INT), NULL) != CS_SUCCEED) {
1844 warn("cs_dt_info() failed");
1845
1846 return 0;
1847 }
1848 switch (type) {
1849 case CS_DATES_LONG:
1850 p = "LONG";
1851 break;
1852 case CS_DATES_SHORT:
1853 p = "SHORT";
1854 break;
1855 case CS_DATES_DMY4_YYYY:
1856 p = "DMY4_YYYY";
1857 break;
1858 case CS_DATES_MDY1_YYYY:
1859 p = "MDY1_YYYY";
1860 break;
1861 case CS_DATES_DMY1_YYYY:
1862 p = "DMY1_YYYY";
1863 break;
1864 case CS_DATES_DMY2_YYYY:
1865 p = "DMY2_YYYY";
1866 break;
1867 case CS_DATES_YMD3_YYYY:
1868 p = "YMD3_YYYY";
1869 break;
1870 case CS_DATES_HMS:
1871 p = "HMS";
1872 break;
1873 default:
1874 p = "Unknown";
1875 break;
1876 }
1877 strcpy(fmt, p);
1878
1879 return 1;
1880 }
1881
syb_discon_all(SV * drh,imp_drh_t * imp_drh)1882 int syb_discon_all(SV *drh, imp_drh_t *imp_drh) {
1883 /* disconnect_all is not implemented */
1884 return 1;
1885 }
1886
1887 #if defined(NO_BLK)
syb_blk_done(imp_sth_t * imp_sth,CS_INT type)1888 static int syb_blk_done(imp_sth_t *imp_sth, CS_INT type)
1889 {
1890 return 1;
1891 }
1892 #else
syb_blk_done(imp_sth_t * imp_sth,CS_INT type)1893 static int syb_blk_done(imp_sth_t *imp_sth, CS_INT type) {
1894 CS_RETCODE ret;
1895
1896 /* if $dbh->commit is called but no rows have been successfully
1897 sent to the server then blk_done(CS_BLK_BATCH) fails. Avoid
1898 the failure by simply not calling blk_done() in that situation. */
1899 if (type == CS_BLK_BATCH && !imp_sth->bcpRows) {
1900 return 1;
1901 }
1902 ret = blk_done(imp_sth->bcp_desc, type, &imp_sth->numRows);
1903 if (DBIc_DBISTATE(imp_sth)->debug >= 4)
1904 PerlIO_printf(DBIc_LOGPIO(imp_sth),
1905 " syb_blk_done -> blk_done(%d, %d, %d) = %d\n",
1906 imp_sth->bcp_desc, type, imp_sth->numRows, ret);
1907
1908 /* reset row counter if blk_done was successful */
1909 if (ret == CS_SUCCEED) {
1910 if (type == CS_BLK_CANCEL)
1911 imp_sth->bcpRows = -1;
1912 else
1913 imp_sth->bcpRows = 0;
1914 }
1915
1916 if (DBIc_DBISTATE(imp_sth)->debug >= 3)
1917 PerlIO_printf(DBIc_LOGPIO(imp_sth),
1918 " syb_blk_done(%d) -> ret = %d, rows = %d\n", type, ret,
1919 imp_sth->numRows);
1920
1921 return ret == CS_SUCCEED;
1922 }
1923 #endif
1924
syb_db_commit(SV * dbh,imp_dbh_t * imp_dbh)1925 int syb_db_commit(SV *dbh, imp_dbh_t *imp_dbh) {
1926 CS_COMMAND *cmd;
1927 char buff[128];
1928 CS_INT restype;
1929 CS_RETCODE retcode;
1930 int failFlag = 0;
1931
1932 if (imp_dbh->imp_sth && imp_dbh->imp_sth->bcpFlag) {
1933 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1934 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
1935 " syb_db_commit() -> bcp op, calling syb_blk_done()\n");
1936 return syb_blk_done(imp_dbh->imp_sth, CS_BLK_BATCH);
1937 }
1938
1939 if (imp_dbh->doRealTran && !imp_dbh->inTransaction)
1940 return 1;
1941
1942 if (DBIc_is(imp_dbh, DBIcf_AutoCommit)) {
1943 warn("commit ineffective with AutoCommit");
1944 return 1;
1945 }
1946
1947 cmd = syb_alloc_cmd(imp_dbh, imp_dbh->connection);
1948 if (imp_dbh->doRealTran)
1949 sprintf(buff, "\nCOMMIT TRAN %s\n", imp_dbh->tranName);
1950 else
1951 strcpy(buff, "\nCOMMIT TRAN\n");
1952 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1953 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
1954 " syb_db_commit() -> ct_command(%s)\n", buff);
1955 retcode = ct_command(cmd, CS_LANG_CMD, buff, CS_NULLTERM, CS_UNUSED);
1956 if (retcode != CS_SUCCEED)
1957 return 0;
1958
1959 if (ct_send(cmd) != CS_SUCCEED)
1960 return 0;
1961
1962 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1963 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
1964 " syb_db_commit() -> ct_send() OK\n");
1965
1966 while ((retcode = ct_results(cmd, &restype)) == CS_SUCCEED) {
1967 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1968 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
1969 " syb_db_commit() -> ct_results(%d) == %d\n", restype,
1970 retcode);
1971
1972 if (restype == CS_CMD_FAIL)
1973 failFlag = 1;
1974 }
1975
1976 ct_cmd_drop(cmd);
1977 imp_dbh->inTransaction = 0;
1978
1979 return !failFlag;
1980 }
1981
syb_db_rollback(SV * dbh,imp_dbh_t * imp_dbh)1982 int syb_db_rollback(SV *dbh, imp_dbh_t *imp_dbh) {
1983 CS_COMMAND *cmd;
1984 char buff[128];
1985 CS_INT restype;
1986 CS_RETCODE retcode;
1987 int failFlag = 0;
1988
1989 if (imp_dbh->imp_sth && imp_dbh->imp_sth->bcpFlag) {
1990 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
1991 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
1992 " syb_db_rollback() -> bcp op, calling syb_blk_done()\n");
1993 return syb_blk_done(imp_dbh->imp_sth, CS_BLK_CANCEL);
1994 }
1995
1996 if (imp_dbh->doRealTran && !imp_dbh->inTransaction)
1997 return 1;
1998
1999 if (DBIc_is(imp_dbh, DBIcf_AutoCommit)) {
2000 warn("rollback ineffective with AutoCommit");
2001 return 1;
2002 }
2003
2004 cmd = syb_alloc_cmd(imp_dbh, imp_dbh->connection);
2005 if (imp_dbh->doRealTran)
2006 sprintf(buff, "\nROLLBACK TRAN %s\n", imp_dbh->tranName);
2007 else
2008 strcpy(buff, "\nROLLBACK TRAN\n");
2009 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
2010 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
2011 " syb_db_rollback() -> ct_command(%s)\n", buff);
2012 retcode = ct_command(cmd, CS_LANG_CMD, buff, CS_NULLTERM, CS_UNUSED);
2013 if (retcode != CS_SUCCEED)
2014 return 0;
2015
2016 if (ct_send(cmd) != CS_SUCCEED)
2017 return 0;
2018
2019 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
2020 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
2021 " syb_db_rollback() -> ct_send() OK\n");
2022
2023 while ((retcode = ct_results(cmd, &restype)) == CS_SUCCEED) {
2024 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
2025 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
2026 " syb_db_rollback() -> ct_results(%d) == %d\n", restype,
2027 retcode);
2028
2029 if (restype == CS_CMD_FAIL)
2030 failFlag = 1;
2031 }
2032
2033 ct_cmd_drop(cmd);
2034 imp_dbh->inTransaction = 0;
2035 return !failFlag;
2036 }
2037
syb_db_opentran(SV * dbh,imp_dbh_t * imp_dbh)2038 static int syb_db_opentran(SV *dbh, imp_dbh_t *imp_dbh) {
2039 CS_COMMAND *cmd;
2040 char buff[128];
2041 CS_INT restype;
2042 CS_RETCODE retcode;
2043 int failFlag = 0;
2044
2045 if (DBIc_is(imp_dbh, DBIcf_AutoCommit) || imp_dbh->inTransaction)
2046 return 1;
2047
2048 cmd = syb_alloc_cmd(imp_dbh, imp_dbh->connection);
2049 sprintf(imp_dbh->tranName, "DBI%x", imp_dbh);
2050 sprintf(buff, "\nBEGIN TRAN %s\n", imp_dbh->tranName);
2051 retcode = ct_command(cmd, CS_LANG_CMD, buff, CS_NULLTERM, CS_UNUSED);
2052 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
2053 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
2054 " syb_db_opentran() -> ct_command(%s) = %d\n", buff, retcode);
2055 if (retcode != CS_SUCCEED)
2056 return 0;
2057 retcode = ct_send(cmd);
2058 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
2059 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
2060 " syb_db_opentran() -> ct_send() = %d\n", retcode);
2061
2062 if (retcode != CS_SUCCEED)
2063 return 0;
2064
2065 while ((retcode = ct_results(cmd, &restype)) == CS_SUCCEED) {
2066 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
2067 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
2068 " syb_db_opentran() -> ct_results(%d) == %d\n", restype,
2069 retcode);
2070
2071 if (restype == CS_CMD_FAIL)
2072 failFlag = 1;
2073 }
2074
2075 ct_cmd_drop(cmd);
2076 if (!failFlag)
2077 imp_dbh->inTransaction = 1;
2078 return !failFlag;
2079 }
2080
syb_db_disconnect(SV * dbh,imp_dbh_t * imp_dbh)2081 int syb_db_disconnect(SV *dbh, imp_dbh_t *imp_dbh) {
2082 dTHX;
2083 CS_RETCODE retcode;
2084
2085 /* If we are called in a process that is different from the one where the handle
2086 * was created then we do NOT disconnect.
2087 */
2088 if (imp_dbh->disconnectInChild = 0 && imp_dbh->pid != getpid()) {
2089 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
2090 PerlIO_printf(
2091 DBIc_LOGPIO(imp_dbh),
2092 " syb_db_disconnect() -> imp_dbh->pid (%d) != pid (%d) - not closing connection\n",
2093 imp_dbh->pid, getpid());
2094 return 0;
2095 }
2096
2097 /* rollback if we get disconnected and no explicit commit
2098 has been called (when in non-AutoCommit mode) */
2099 if (imp_dbh->isDead == 0) { /* only call if connection still active */
2100 if (!DBIc_is(imp_dbh, DBIcf_AutoCommit))
2101 syb_db_rollback(dbh, imp_dbh);
2102 }
2103
2104 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
2105 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
2106 " syb_db_disconnect() -> ct_close()\n");
2107 if ((retcode = ct_close(imp_dbh->connection, CS_FORCE_CLOSE)) != CS_SUCCEED)
2108 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
2109 " syb_db_disconnect(): ct_close() failed\n");
2110
2111 if (imp_dbh->locale && (retcode = cs_loc_drop(context, imp_dbh->locale))
2112 != CS_SUCCEED)
2113 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
2114 " syb_db_disconnect(): cs_loc_drop() failed\n");
2115 if ((retcode = ct_con_drop(imp_dbh->connection)) != CS_SUCCEED)
2116 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
2117 " syb_db_disconnect(): ct_con_drop() failed\n");
2118
2119 DBIc_ACTIVE_off(imp_dbh);
2120
2121 return 1;
2122 }
2123
syb_db_destroy(SV * dbh,imp_dbh_t * imp_dbh)2124 void syb_db_destroy(SV *dbh, imp_dbh_t *imp_dbh) {
2125 if (DBIc_ACTIVE(imp_dbh))
2126 syb_db_disconnect(dbh, imp_dbh);
2127 /* Nothing in imp_dbh to be freed */
2128
2129 DBIc_IMPSET_off(imp_dbh);
2130 }
2131
2132 /* NOTE: if you set any new attributes here that need to be passed on
2133 to Sybase (for example via ct_options()) then make sure that you
2134 also code the same thing in syb_db_connect() so that connections
2135 opened for nested statement handles correctly handle this issue */
2136
syb_db_STORE_attrib(SV * dbh,imp_dbh_t * imp_dbh,SV * keysv,SV * valuesv)2137 int syb_db_STORE_attrib(SV *dbh, imp_dbh_t *imp_dbh, SV *keysv, SV *valuesv) {
2138 dTHX;
2139 STRLEN kl;
2140 int on;
2141 char *key = SvPV(keysv, kl);
2142
2143 if (kl == 15 && strEQ(key, "syb_chained_txn")) {
2144 on = SvTRUE(valuesv);
2145 if (imp_dbh->chainedSupported) {
2146 int autocommit = DBIc_is(imp_dbh, DBIcf_AutoCommit);
2147 if (!autocommit)
2148 syb_db_commit(dbh, imp_dbh);
2149 if (on) {
2150 imp_dbh->doRealTran = 0;
2151 } else {
2152 imp_dbh->doRealTran = 1;
2153 }
2154 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
2155 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
2156 " syb_db_STORE() -> syb_chained_txn => %d\n", on);
2157 if (!autocommit && imp_dbh->optSupported) {
2158 CS_BOOL value = on ? CS_TRUE : CS_FALSE;
2159 CS_RETCODE ret;
2160 ret = syb_set_options(imp_dbh, CS_SET, CS_OPT_CHAINXACTS,
2161 &value, CS_UNUSED, NULL);
2162 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
2163 PerlIO_printf(
2164 DBIc_LOGPIO(imp_dbh),
2165 " syb_db_STORE() -> syb_chained_txn AutoCommit off CS_OPT_CHAINXACTS(%d) => %d\n",
2166 value, ret);
2167 }
2168
2169 } else {
2170 /* XXX - should this issue a warning???? */
2171 }
2172
2173 return TRUE;
2174 }
2175 if (kl == 10 && strEQ(key, "AutoCommit")) {
2176 int crnt = (DBIc_has(imp_dbh, DBIcf_AutoCommit) > 0);
2177 int ret;
2178
2179 /* Move the check for ACTIVE_KIDS below the check for the bcp flag
2180 * as that inhibits the setting of the autocommit variable anyway.
2181 */
2182 if (imp_dbh->imp_sth && imp_dbh->imp_sth->bcpFlag) {
2183 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
2184 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
2185 " syb_db_STORE(): AutoCommit value changes inhibitted during BCP ops\n");
2186 return TRUE;
2187 }
2188
2189 on = SvTRUE(valuesv);
2190 if (DBIc_ACTIVE_KIDS(imp_dbh) && ((on && !crnt) || (!on && crnt))) {
2191 croak(
2192 "panic: can't change AutoCommit (from %d to %d) with active statement handles",
2193 on, crnt);
2194 }
2195
2196 ret = toggle_autocommit(dbh, imp_dbh, on);
2197 DBIc_set(imp_dbh, DBIcf_AutoCommit, on);
2198 return TRUE;
2199 }
2200 if (kl == 11 && strEQ(key, "LongTruncOK")) {
2201 DBIc_set(imp_dbh, DBIcf_LongTruncOk, SvTRUE(valuesv));
2202 return TRUE;
2203 }
2204
2205 if (kl == 11 && strEQ(key, "LongReadLen")) {
2206 CS_INT value = SvIV(valuesv);
2207 CS_RETCODE ret;
2208
2209 if (imp_dbh->inUse) {
2210 warn("Can't set LongReadLen because the database handle is in use.");
2211 return FALSE;
2212 }
2213 ret = syb_set_options(imp_dbh, CS_SET, CS_OPT_TEXTSIZE, &value,
2214 CS_UNUSED, NULL);
2215 if (ret != CS_SUCCEED) {
2216 warn("Setting of CS_OPT_TEXTSIZE failed.");
2217 return FALSE;
2218 }
2219 DBIc_LongReadLen(imp_dbh) = value;
2220
2221 return TRUE;
2222 }
2223
2224 if (kl == 21 && strEQ(key, "syb_quoted_identifier")) {
2225 CS_INT value = SvIV(valuesv);
2226 CS_RETCODE ret;
2227
2228 if (imp_dbh->inUse) {
2229 warn(
2230 "Can't set syb_quoted_identifier because the database handle is in use.");
2231 return FALSE;
2232 }
2233
2234 ret = syb_set_options(imp_dbh, CS_SET, CS_OPT_QUOTED_IDENT, &value,
2235 CS_UNUSED, NULL);
2236 if (ret != CS_SUCCEED) {
2237 warn("Setting of CS_OPT_QUOTED_IDENT failed.");
2238 return FALSE;
2239 }
2240 imp_dbh->quotedIdentifier = value;
2241
2242 return TRUE;
2243 }
2244
2245 if (kl == 12 && strEQ(key, "syb_show_sql")) {
2246 on = SvTRUE(valuesv);
2247 if (on) {
2248 imp_dbh->showSql = 1;
2249 } else {
2250 imp_dbh->showSql = 0;
2251 }
2252 return TRUE;
2253 }
2254 if (kl == 12 && strEQ(key, "syb_show_eed")) {
2255 on = SvTRUE(valuesv);
2256 if (on) {
2257 imp_dbh->showEed = 1;
2258 } else {
2259 imp_dbh->showEed = 0;
2260 }
2261 return TRUE;
2262 }
2263 if (kl == 15 && strEQ(key, "syb_err_handler")) {
2264 if (!SvOK(valuesv)) {
2265 imp_dbh->err_handler = NULL;
2266 } else if (imp_dbh->err_handler == (SV*) NULL) {
2267 imp_dbh->err_handler = newSVsv(valuesv);
2268 } else {
2269 sv_setsv(imp_dbh->err_handler, valuesv);
2270 }
2271 return TRUE;
2272 }
2273 if (kl == 15 && strEQ(key, "syb_enable_utf8")) {
2274 #if !defined(DBD_CAN_HANDLE_UTF8)
2275 warn("The current version of OpenClient can't handle utf8 data.");
2276 return FALSE;
2277 #else
2278 on = SvTRUE(valuesv);
2279 if (on) {
2280 imp_dbh->enable_utf8 = 1;
2281 } else {
2282 imp_dbh->enable_utf8 = 0;
2283 }
2284 return TRUE;
2285 #endif
2286 }
2287 if (kl == 16 && strEQ(key, "syb_row_callback")) {
2288 if (!SvOK(valuesv)) {
2289 imp_dbh->row_cb = NULL;
2290 } else if (imp_dbh->row_cb == (SV*) NULL) {
2291 imp_dbh->row_cb = newSVsv(valuesv);
2292 } else {
2293 sv_setsv(imp_dbh->row_cb, valuesv);
2294 }
2295 return TRUE;
2296 }
2297 if (kl == 16 && strEQ(key, "syb_flush_finish")) {
2298 on = SvTRUE(valuesv);
2299 if (on) {
2300 imp_dbh->flushFinish = 1;
2301 } else {
2302 imp_dbh->flushFinish = 0;
2303 }
2304 return TRUE;
2305 }
2306 if (kl == 12 && strEQ(key, "syb_rowcount")) {
2307 #if defined(CS_OPT_ROWCOUNT)
2308 CS_INT value = SvIV(valuesv);
2309 CS_RETCODE ret;
2310
2311 if (imp_dbh->inUse) {
2312 warn(
2313 "Can't set syb_rowcount because the database handle is in use.");
2314 return FALSE;
2315 }
2316
2317 ret = syb_set_options(imp_dbh, CS_SET, CS_OPT_ROWCOUNT, &value,
2318 CS_UNUSED, NULL);
2319 if (ret != CS_SUCCEED) {
2320 warn("Setting of CS_OPT_ROWCOUNT failed.");
2321 return FALSE;
2322 }
2323 imp_dbh->rowcount = value;
2324 return TRUE;
2325 #else
2326 return FALSE;
2327 #endif
2328 }
2329 if (kl == 21 && strEQ(key, "syb_dynamic_supported")) {
2330 warn("'syb_dynamic_supported' is a read-only attribute");
2331 return TRUE;
2332 }
2333 if (kl == 18 && strEQ(key, "syb_do_proc_status")) {
2334 on = SvTRUE(valuesv);
2335 if (on) {
2336 imp_dbh->doProcStatus = 1;
2337 } else {
2338 imp_dbh->doProcStatus = 0;
2339 }
2340 return TRUE;
2341 }
2342 if (kl == 14 && strEQ(key, "syb_use_bin_0x")) {
2343 on = SvTRUE(valuesv);
2344 if (on) {
2345 imp_dbh->useBin0x = 1;
2346 } else {
2347 imp_dbh->useBin0x = 0;
2348 }
2349 return TRUE;
2350 }
2351 if (kl == 17 && strEQ(key, "syb_binary_images")) {
2352 on = SvTRUE(valuesv);
2353 if (on) {
2354 imp_dbh->binaryImage = 1;
2355 } else {
2356 imp_dbh->binaryImage = 0;
2357 }
2358 return TRUE;
2359 }
2360 if (kl == 18 && strEQ(key, "syb_deadlock_retry")) {
2361 int value = SvIV(valuesv);
2362 imp_dbh->deadlockRetry = value;
2363
2364 return TRUE;
2365 }
2366 if (kl == 18 && strEQ(key, "syb_deadlock_sleep")) {
2367 int value = SvIV(valuesv);
2368 imp_dbh->deadlockSleep = value;
2369
2370 return TRUE;
2371 }
2372 if (kl == 20 && strEQ(key, "syb_deadlock_verbose")) {
2373 int value = SvIV(valuesv);
2374 imp_dbh->deadlockVerbose = value;
2375
2376 return TRUE;
2377 }
2378
2379 if (kl == 17 && strEQ(key, "syb_nsql_nostatus")) {
2380 int value = SvIV(valuesv);
2381 imp_dbh->nsqlNoStatus = value;
2382
2383 return TRUE;
2384 }
2385
2386 if (kl == 16 && strEQ(key, "syb_no_child_con")) {
2387 imp_dbh->noChildCon = SvIV(valuesv);
2388
2389 return TRUE;
2390 }
2391 if (kl == 19 && strEQ(key, "syb_failed_db_fatal")) {
2392 imp_dbh->failedDbUseFatal = SvIV(valuesv);
2393
2394 return TRUE;
2395 }
2396 if (kl == 29 && strEQ(key, "syb_bind_empty_string_as_null")) {
2397 imp_dbh->bindEmptyStringNull = SvIV(valuesv);
2398
2399 return TRUE;
2400 }
2401
2402 if (kl == 27 && strEQ(key, "syb_cancel_request_on_error")) {
2403 imp_dbh->alwaysForceFailure = SvIV(valuesv);
2404
2405 return TRUE;
2406 }
2407 if (kl == 23 && strEQ(key, "syb_disconnect_in_child")) {
2408 imp_dbh->disconnectInChild = SvIV(valuesv);
2409
2410 return TRUE;
2411 }
2412
2413 if (kl == 18 && strEQ(key, "syb_server_version")) {
2414 strncpy(imp_dbh->serverVersion, SvPV(valuesv, PL_na), 15);
2415
2416 return TRUE;
2417 }
2418
2419 if (kl == 12 && strEQ(key, "syb_date_fmt")) {
2420 syb_db_date_fmt(dbh, imp_dbh, SvPV(valuesv, PL_na));
2421
2422 return TRUE;
2423 }
2424
2425 return FALSE;
2426 }
2427
syb_db_FETCH_attrib(SV * dbh,imp_dbh_t * imp_dbh,SV * keysv)2428 SV *syb_db_FETCH_attrib(SV *dbh, imp_dbh_t *imp_dbh, SV *keysv) {
2429 dTHX;
2430 STRLEN kl;
2431 char *key = SvPV(keysv, kl);
2432 SV *retsv = NULL;
2433
2434 if (kl == 10 && strEQ(key, "AutoCommit")) {
2435 if (DBIc_is(imp_dbh, DBIcf_AutoCommit))
2436 retsv = newSViv(1);
2437 else
2438 retsv = newSViv(0);
2439 }
2440 if (kl == 11 && strEQ(key, "LongTruncOK")) {
2441 if (DBIc_is(imp_dbh, DBIcf_LongTruncOk))
2442 retsv = newSViv(1);
2443 else
2444 retsv = newSViv(0);
2445 }
2446 if (kl == 11 && strEQ(key, "LongReadLen")) {
2447 retsv = newSViv(DBIc_LongReadLen(imp_dbh));
2448 }
2449 if (kl == 12 && strEQ(key, "syb_show_sql")) {
2450 if (imp_dbh->showSql)
2451 retsv = newSViv(1);
2452 else
2453 retsv = newSViv(0);
2454 }
2455 if (kl == 12 && strEQ(key, "syb_show_eed")) {
2456 if (imp_dbh->showEed)
2457 retsv = newSViv(1);
2458 else
2459 retsv = newSViv(0);
2460 }
2461 if (kl == 8 && strEQ(key, "syb_dead")) {
2462 if (imp_dbh->isDead)
2463 retsv = newSViv(1);
2464 else
2465 retsv = newSViv(0);
2466 }
2467 if (kl == 15 && strEQ(key, "syb_err_handler")) {
2468 if (imp_dbh->err_handler) {
2469 retsv = newSVsv(imp_dbh->err_handler);
2470 } else {
2471 retsv = &PL_sv_undef;
2472 }
2473 }
2474 if (kl == 15 && strEQ(key, "syb_enable_utf8")) {
2475 if (imp_dbh->enable_utf8) {
2476 retsv = newSViv(1);
2477 } else {
2478 retsv = newSViv(0);
2479 }
2480 }
2481 if (kl == 16 && strEQ(key, "syb_row_callback")) {
2482 if (imp_dbh->row_cb) {
2483 retsv = newSVsv(imp_dbh->row_cb);
2484 } else {
2485 retsv = &PL_sv_undef;
2486 }
2487 }
2488 if (kl == 15 && strEQ(key, "syb_chained_txn")) {
2489 if (imp_dbh->doRealTran)
2490 retsv = newSViv(0);
2491 else
2492 retsv = newSViv(1);
2493 }
2494 if (kl == 18 && strEQ(key, "syb_check_tranmode")) {
2495 CS_INT value;
2496 CS_RETCODE ret;
2497
2498 ret = syb_set_options(imp_dbh, CS_GET, CS_OPT_CHAINXACTS, &value,
2499 CS_UNUSED, NULL);
2500 if (ret != CS_SUCCEED)
2501 value = 0;
2502 retsv = newSViv(value);
2503 }
2504 if (kl == 16 && strEQ(key, "syb_flush_finish")) {
2505 if (imp_dbh->flushFinish)
2506 retsv = newSViv(1);
2507 else
2508 retsv = newSViv(0);
2509 }
2510 if (kl == 21 && strEQ(key, "syb_dynamic_supported")) {
2511 CS_BOOL val;
2512 CS_RETCODE ret = ct_capability(imp_dbh->connection, CS_GET,
2513 CS_CAP_REQUEST, CS_REQ_DYN, (CS_VOID*) &val);
2514 if (ret != CS_SUCCEED || val == CS_FALSE)
2515 retsv = newSViv(0);
2516 else
2517 retsv = newSViv(1);
2518 }
2519
2520 if (kl == 21 && strEQ(key, "syb_quoted_identifier")) {
2521 if (imp_dbh->quotedIdentifier)
2522 retsv = newSViv(1);
2523 else
2524 retsv = newSViv(0);
2525 }
2526 if (kl == 12 && strEQ(key, "syb_rowcount")) {
2527 retsv = newSViv(imp_dbh->rowcount);
2528 }
2529
2530 if (kl == 14 && strEQ(key, "syb_oc_version")) {
2531 retsv = newSVpv(ocVersion, strlen(ocVersion));
2532 }
2533 if (kl == 18 && strEQ(key, "syb_do_proc_status")) {
2534 retsv = newSViv(imp_dbh->doProcStatus);
2535 }
2536 if (kl == 14 && strEQ(key, "syb_use_bin_0x")) {
2537 if (imp_dbh->useBin0x)
2538 retsv = newSViv(1);
2539 else
2540 retsv = newSViv(0);
2541 }
2542 if (kl == 17 && strEQ(key, "syb_binary_images")) {
2543 if (imp_dbh->binaryImage)
2544 retsv = newSViv(1);
2545 else
2546 retsv = newSViv(0);
2547 }
2548 if (kl == 18 && strEQ(key, "syb_deadlock_retry")) {
2549 retsv = newSViv(imp_dbh->deadlockRetry);
2550 }
2551 if (kl == 18 && strEQ(key, "syb_deadlock_sleep")) {
2552 retsv = newSViv(imp_dbh->deadlockSleep);
2553 }
2554 if (kl == 20 && strEQ(key, "syb_deadlock_verbose")) {
2555 retsv = newSViv(imp_dbh->deadlockVerbose);
2556 }
2557 if (kl == 17 && strEQ(key, "syb_nsql_nostatus")) {
2558 retsv = newSViv(imp_dbh->nsqlNoStatus);
2559 }
2560
2561 if (kl == 16 && strEQ(key, "syb_no_child_con")) {
2562 retsv = newSViv(imp_dbh->noChildCon);
2563 }
2564 if (kl == 19 && strEQ(key, "syb_failed_db_fatal")) {
2565 retsv = newSViv(imp_dbh->failedDbUseFatal);
2566 }
2567 if (kl == 29 && strEQ(key, "syb_bind_empty_string_as_null")) {
2568 retsv = newSViv(imp_dbh->bindEmptyStringNull);
2569 }
2570 if (kl == 27 && strEQ(key, "syb_cancel_request_on_error")) {
2571 retsv = newSViv(imp_dbh->alwaysForceFailure);
2572 }
2573 if (kl == 23 && strEQ(key, "syb_disconnect_in_child")) {
2574 retsv = newSViv(imp_dbh->disconnectInChild);
2575 }
2576 if (kl == 18 && strEQ(key, "syb_server_version")) {
2577 retsv = newSVpv(imp_dbh->serverVersion, 0);
2578 }
2579 if (kl == 25 && strEQ(key, "syb_server_version_string")) {
2580 retsv = newSVpv(imp_dbh->serverVersionString, 0);
2581 }
2582
2583 if (kl == 12 && strEQ(key, "syb_date_fmt")) {
2584 char buff[50];
2585 syb_get_date_fmt(imp_dbh, buff);
2586 retsv = newSVpv(buff, 0);
2587 }
2588 if (kl == 11 && strEQ(key, "syb_has_blk")) {
2589 #if defined(NO_BLK)
2590 retsv = &PL_sv_no;
2591 #else
2592 retsv = &PL_sv_yes;
2593 #endif
2594 }
2595
2596 if (retsv == &PL_sv_yes || retsv == &PL_sv_no || retsv == &PL_sv_undef)
2597 return retsv;
2598
2599 return sv_2mortal(retsv);
2600 }
2601
syb_alloc_cmd(imp_dbh_t * imp_dbh,CS_CONNECTION * connection)2602 static CS_COMMAND * syb_alloc_cmd(imp_dbh_t *imp_dbh, CS_CONNECTION *connection) {
2603 CS_COMMAND *cmd;
2604 CS_RETCODE retcode;
2605
2606 if ((retcode = ct_cmd_alloc(connection, &cmd)) != CS_SUCCEED) {
2607 syb_set_error(imp_dbh, -1, "ct_cmd_alloc failed");
2608 return NULL;
2609 }
2610 if (DBIc_DBISTATE(imp_dbh)->debug >= 4)
2611 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
2612 " syb_alloc_cmd() -> CS_COMMAND %x for CS_CONNECTION %x\n",
2613 cmd, connection);
2614
2615 return cmd;
2616 }
2617
dbd_preparse(imp_sth_t * imp_sth,char * statement)2618 static void dbd_preparse(imp_sth_t *imp_sth, char *statement) {
2619 dTHX;
2620 enum {
2621 DEFAULT, LITERAL, COMMENT, LINE_COMMENT, VARIABLE
2622 } STATES;
2623 int state = DEFAULT;
2624 int next_state;
2625 char last_literal = 0;
2626 char *src, *start, *dest;
2627 phs_t phs_tpl;
2628 SV *phs_sv;
2629 int idx = 0;
2630 STRLEN namelen;
2631 #define VARNAME_LEN 255
2632 char varname[VARNAME_LEN + 1];
2633 int pos;
2634
2635 /* allocate room for copy of statement with spare capacity */
2636 imp_sth->statement = (char*) safemalloc(strlen(statement) * 3);
2637
2638 /* initialise phs ready to be cloned per placeholder */
2639 memset(&phs_tpl, 0, sizeof(phs_tpl));
2640 phs_tpl.ftype = CS_VARCHAR_TYPE;
2641 varname[0] = 0;
2642
2643 /* check for a leading EXEC. If it is present then set imp_sth->type
2644 to 1 to indicate that we are doing an RPC call.
2645 */
2646
2647 src = statement;
2648 while (isspace(*src) && *src)
2649 /* skip over leading whitespace */
2650 ++src;
2651 if (!strncasecmp(src, "exec", 4))
2652 imp_sth->type = 1;
2653 else if (imp_sth->bcpFlag)
2654 imp_sth->type = 2;
2655 else
2656 imp_sth->type = 0;
2657
2658 src = statement;
2659 dest = imp_sth->statement;
2660 while (*src) {
2661 next_state = state; /* default situation */
2662 switch (state) {
2663 case DEFAULT:
2664 if (*src == '\'' || *src == '"') {
2665 last_literal = *src;
2666 next_state = LITERAL;
2667 } else if (*src == '/' && *(src + 1) == '*') {
2668 next_state = COMMENT;
2669 } else if (*src == '-' && *(src + 1) == '-') {
2670 next_state = LINE_COMMENT;
2671 } else if (*src == '@') {
2672 varname[0] = '@';
2673 pos = 1;
2674 next_state = VARIABLE;
2675 }
2676 break;
2677 case LITERAL:
2678 if (*src == last_literal) {
2679 next_state = DEFAULT;
2680 }
2681 break;
2682 case COMMENT:
2683 if (*(src - 1) == '*' && *src == '/') {
2684 next_state = DEFAULT;
2685 }
2686 break;
2687 case LINE_COMMENT:
2688 if (*src == '\n') {
2689 next_state = DEFAULT;
2690 }
2691 break;
2692 case VARIABLE:
2693 if (!isalnum(*src) && *src != '_') {
2694 varname[pos] = 0;
2695 next_state = DEFAULT;
2696 } else if (pos < VARNAME_LEN) {
2697 varname[pos++] = *src;
2698 }
2699 }
2700 /* printf("state = %d, *src = %c, next_state = %d\n", state, *src, next_state); */
2701
2702 if (state != DEFAULT || *src != '?') {
2703 *dest++ = *src++;
2704 state = next_state;
2705 continue;
2706 }
2707 state = next_state;
2708 start = dest; /* save name inc colon */
2709 *dest++ = *src++;
2710 if (*start == '?') { /* X/Open standard */
2711 sprintf(start, ":p%d", ++idx); /* '?' -> ':p1' (etc) */
2712 dest = start + strlen(start);
2713 } else { /* not a placeholder, so just copy */
2714 continue;
2715 }
2716 *dest = '\0'; /* handy for debugging */
2717 namelen = (dest - start);
2718 if (imp_sth->all_params_hv == NULL)
2719 imp_sth->all_params_hv = newHV();
2720 phs_tpl.sv = &PL_sv_undef;
2721 phs_sv = newSVpv((char*) &phs_tpl, sizeof(phs_tpl) + namelen + 1);
2722 hv_store(imp_sth->all_params_hv, start, namelen, phs_sv, 0);
2723 strcpy(((phs_t*) (void*) SvPVX(phs_sv))->name, start);
2724 strcpy(((phs_t*) (void*) SvPVX(phs_sv))->varname, varname);
2725 if (imp_sth->type == 1) { /* if it's an EXEC call, check for OUTPUT */
2726 char *p = src;
2727 do {
2728 if (*p == ',')
2729 break;
2730 if (isspace(*p))
2731 continue;
2732 if (isalpha(*p)) {
2733 if (!strncasecmp(p, "out", 3)) {
2734 ((phs_t*) (void*) SvPVX(phs_sv))->is_inout = 1;
2735 } else {
2736 break;
2737 }
2738 }
2739 } while (*(++p));
2740 }
2741 if (DBIc_DBISTATE(imp_sth)->debug >= 3)
2742 PerlIO_printf(DBIc_LOGPIO(imp_sth),
2743 " dbd_preparse parameter %s (%s)\n",
2744 ((phs_t*) (void*) SvPVX(phs_sv))->name,
2745 ((phs_t*) (void*) SvPVX(phs_sv))->varname);
2746 /* warn("params_hv: '%s'\n", start); */
2747 }
2748 *dest = '\0';
2749 if (imp_sth->all_params_hv) {
2750 DBIc_NUM_PARAMS(imp_sth) = (int) HvKEYS(imp_sth->all_params_hv);
2751 if (DBIc_DBISTATE(imp_sth)->debug >= 3)
2752 PerlIO_printf(DBIc_LOGPIO(imp_sth),
2753 " dbd_preparse scanned %d distinct placeholders\n",
2754 (int) DBIc_NUM_PARAMS(imp_sth));
2755 }
2756 }
2757
dyn_prepare(imp_dbh_t * imp_dbh,imp_sth_t * imp_sth,char * statement)2758 static CS_RETCODE dyn_prepare(imp_dbh_t *imp_dbh, imp_sth_t *imp_sth,
2759 char* statement) {
2760 dTHX;
2761 CS_INT restype;
2762 static int tt = 1;
2763 int failed = 0;
2764 CS_BOOL val;
2765 CS_RETCODE ret;
2766
2767 ret = ct_capability(imp_dbh->connection, CS_GET, CS_CAP_REQUEST,
2768 CS_REQ_DYN, (CS_VOID*) &val);
2769 if (ret != CS_SUCCEED || val == CS_FALSE)
2770 croak(
2771 "Panic: dynamic SQL (? placeholders) are not supported by the server you are connecting to");
2772
2773 sprintf(imp_sth->dyn_id, "DBD%d", (int) tt++);
2774
2775 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
2776 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
2777 " dyn_prepare: ct_dynamic(CS_PREPARE) for %s\n",
2778 imp_sth->dyn_id);
2779
2780 imp_sth->dyn_execed = 0;
2781
2782 imp_sth->cmd = syb_alloc_cmd(imp_dbh,
2783 imp_sth->connection ? imp_sth->connection : imp_dbh->connection);
2784
2785 ret = ct_dynamic(imp_sth->cmd, CS_PREPARE, imp_sth->dyn_id, CS_NULLTERM,
2786 statement, CS_NULLTERM);
2787 if (ret != CS_SUCCEED) {
2788 warn("ct_dynamic(CS_PREPARE) returned %d", ret);
2789 return ret;
2790 }
2791 ret = ct_send(imp_sth->cmd);
2792 if (ret != CS_SUCCEED) {
2793 warn("ct_send(ct_dynamic(CS_PREPARE)) returned %d", ret);
2794 return ret;
2795 }
2796 while ((ret = ct_results(imp_sth->cmd, &restype)) == CS_SUCCEED)
2797 if (restype == CS_CMD_FAIL)
2798 failed = 1;
2799
2800 if (ret == CS_FAIL || failed) {
2801 warn("ct_result(ct_dynamic(CS_PREPARE)) returned %d", ret);
2802 return ret;
2803 }
2804 ret = ct_dynamic(imp_sth->cmd, CS_DESCRIBE_INPUT, imp_sth->dyn_id,
2805 CS_NULLTERM, NULL, CS_UNUSED);
2806 if (ret != CS_SUCCEED)
2807 warn("ct_dynamic(CS_DESCRIBE_INPUT) returned %d", ret);
2808 ret = ct_send(imp_sth->cmd);
2809 if (ret != CS_SUCCEED)
2810 warn("ct_send(CS_DESCRIBE_INPUT) returned %d", ret);
2811 if (DBIc_DBISTATE(imp_dbh)->debug >= 4)
2812 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
2813 " dyn_prepare: ct_dynamic(CS_DESCRIBE_INPUT) for %s\n",
2814 imp_sth->dyn_id);
2815 while ((ret = ct_results(imp_sth->cmd, &restype)) == CS_SUCCEED) {
2816 if (DBIc_DBISTATE(imp_dbh)->debug >= 4)
2817 PerlIO_printf(
2818 DBIc_LOGPIO(imp_dbh),
2819 " dyn_prepare: ct_results(CS_DESCRIBE_INPUT) for %s - restype %d\n",
2820 imp_sth->dyn_id, restype);
2821 if (restype == CS_DESCRIBE_RESULT) {
2822 CS_INT num_param, outlen;
2823 int i;
2824 char name[50];
2825 SV **svp;
2826 phs_t *phs;
2827 int ret;
2828
2829 ret = ct_res_info(imp_sth->cmd, CS_NUMDATA, &num_param, CS_UNUSED,
2830 &outlen);
2831 if (ret != CS_SUCCEED)
2832 warn("ct_res_info(CS_DESCRIBE_INPUT) returned %d", ret);
2833 if (DBIc_DBISTATE(imp_dbh)->debug >= 4)
2834 PerlIO_printf(
2835 DBIc_LOGPIO(imp_dbh),
2836 " dyn_prepare: ct_res_info(CS_DESCRIBE_INPUT) statement has %d parameters\n",
2837 num_param);
2838 for (i = 1; i <= num_param; ++i) {
2839 sprintf(name, ":p%d", i);
2840 svp = hv_fetch(imp_sth->all_params_hv, name, strlen(name), 0);
2841 phs = ((phs_t*) (void*) SvPVX(*svp));
2842 ct_describe(imp_sth->cmd, i, &phs->datafmt);
2843 if (DBIc_DBISTATE(imp_dbh)->debug >= 4)
2844 PerlIO_printf(
2845 DBIc_LOGPIO(imp_dbh),
2846 " dyn_prepare: ct_describe(CS_DESCRIBE_INPUT) col %d, type %d, name %s, status %d, length %d\n",
2847 i, phs->datafmt.datatype, phs->datafmt.name,
2848 phs->datafmt.status, phs->datafmt.maxlength);
2849 }
2850 }
2851 }
2852 if (ct_dynamic(imp_sth->cmd, CS_EXECUTE, imp_sth->dyn_id, CS_NULLTERM,
2853 NULL, CS_UNUSED) != CS_SUCCEED)
2854 ret = CS_FAIL;
2855 else {
2856 ret = CS_SUCCEED;
2857 imp_sth->dyn_execed = 1;
2858 }
2859
2860 return ret;
2861 }
2862
syb_st_prepare(SV * sth,imp_sth_t * imp_sth,char * statement,SV * attribs)2863 int syb_st_prepare(SV *sth, imp_sth_t *imp_sth, char *statement, SV *attribs) {
2864 dTHX;
2865 D_imp_dbh_from_sth;
2866 CS_RETCODE ret;
2867
2868 /* PerlIO_printf(DBIc_LOGPIO(imp_dbh), "st_prepare on %x\n", imp_sth); */
2869
2870 sv_setpv(DBIc_ERRSTR(imp_dbh), "");
2871
2872 /* Don't try to initiate a new command if the connection isn't active! */
2873 if (!DBIc_ACTIVE(imp_dbh)) {
2874 syb_set_error(imp_dbh, -1, "Database disconnected");
2875 return 0;
2876 }
2877
2878 /* Check to see if the syb_bcp_attribs flag is set */
2879 getBcpAttribs(imp_sth, attribs);
2880
2881 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
2882 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
2883 " syb_st_prepare() -> inUse = %d\n", imp_dbh->inUse);
2884
2885 if (DBIc_ACTIVE_KIDS(DBIc_PARENT_COM(imp_sth)) || imp_dbh->inUse) {
2886 int retval = 1;
2887
2888 if (imp_dbh->noChildCon) { /* inhibit child connections to be created */
2889 syb_set_error(imp_dbh, -1,
2890 "DBD::Sybase error: Can't create child connections when syb_no_chld_con is set");
2891 return 0;
2892 }
2893 if (!DBIc_is(imp_dbh, DBIcf_AutoCommit))
2894 croak(
2895 "Panic: Can't have multiple statement handles on a single database handle when AutoCommit is OFF");
2896 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
2897 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
2898 " syb_st_prepare() parent has active kids - opening new connection\n");
2899
2900 #if PERL_VERSION >= 8 && defined(_REENTRANT)
2901 MUTEX_LOCK(context_alloc_mutex);
2902 #endif
2903 if ((imp_sth->connection = syb_db_connect(imp_dbh)) == NULL)
2904 retval = 0;
2905
2906 #if PERL_VERSION >= 8 && defined(_REENTRANT)
2907 MUTEX_UNLOCK(context_alloc_mutex);
2908 #endif
2909
2910 if (!retval)
2911 return retval;
2912 }
2913
2914 if (imp_sth->statement != NULL)
2915 Safefree(imp_sth->statement);
2916 imp_sth->statement = NULL;
2917 dbd_preparse(imp_sth, statement);
2918 imp_dbh->sql = imp_sth->statement;
2919
2920 if (!DBIc_is(imp_dbh, DBIcf_AutoCommit) && imp_dbh->doRealTran)
2921 if (syb_db_opentran(NULL, imp_dbh) == 0)
2922 return -2;
2923
2924 if ((int) DBIc_NUM_PARAMS(imp_sth)) {
2925 /* regular dynamic sql */
2926 if (imp_sth->type == 0) {
2927 ret = dyn_prepare(imp_dbh, imp_sth, statement);
2928 if (ret != CS_SUCCEED) {
2929 return 0;
2930 }
2931 } else if (imp_sth->type == 1) {
2932 /* RPC call - get the proc name */
2933 /* We could possibly get the proc params from syscolumns, but
2934 there are a lot of issues with that which will break it */
2935 if (!syb_st_describe_proc(imp_sth, statement)) {
2936 croak("DBD::Sybase: describe_proc failed!\n");
2937 }
2938 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
2939 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
2940 " describe_proc: procname = %s\n", imp_sth->proc);
2941
2942 imp_sth->cmd = syb_alloc_cmd(imp_dbh,
2943 imp_sth->connection ? imp_sth->connection
2944 : imp_dbh->connection);
2945 ret = CS_SUCCEED;
2946 imp_sth->dyn_execed = 0;
2947 } else {
2948 /* BLK operation! */
2949 ret = syb_blk_init(imp_dbh, imp_sth);
2950 }
2951 } else {
2952 /* If this is a blk request (i.e. the syb_bcp_attribs hash is set
2953 in the prepare() call, then force a failure, because no
2954 parameters (placeholders) have been defined. */
2955 if (imp_sth->type == 2) {
2956 syb_set_error(imp_dbh, -1,
2957 "The syb_bcp_attribs attribute is set, but no placeholders found in the query");
2958 return 0;
2959 }
2960
2961 imp_sth->cmd = NULL;
2962 /* Early execution has some unwanted side effects - disabling
2963 it in 1.05_02. */
2964 #if 0
2965 if(cmd_execute(sth, imp_sth) != 0) {
2966 return 0;
2967 }
2968 #endif
2969
2970 ret = CS_SUCCEED;
2971 }
2972
2973 if (ret != CS_SUCCEED)
2974 return 0;
2975
2976 imp_sth->doProcStatus = imp_dbh->doProcStatus;
2977
2978 DBIc_on(imp_sth, DBIcf_IMPSET);
2979
2980 if (!imp_sth->connection) {
2981 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
2982 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
2983 " syb_st_prepare() -> set inUse\n");
2984 imp_dbh->inUse = 1;
2985 }
2986
2987 /* Re-enable the active flag here (in 1.05_03) to fix bug with
2988 finish not getting called correctly */
2989 DBIc_ACTIVE_on(imp_sth);
2990
2991 return 1;
2992 }
2993
syb_st_describe_proc(imp_sth_t * imp_sth,char * statement)2994 static int syb_st_describe_proc(imp_sth_t *imp_sth, char *statement) {
2995 char *buff = my_strdup(statement);
2996 char *tok;
2997
2998 tok = strtok(buff, " \n\t");
2999 if (strncasecmp(tok, "exec", 4)) {
3000 Safefree(buff);
3001 return 0; /* it's gotta start with exec(ute) */
3002 }
3003 tok = strtok(NULL, " \n\t"); /* this is the proc name */
3004 if (!tok || !*tok) {
3005 warn(
3006 "DBD::Sybase: describe_proc: didn't get a proc name in EXEC statement\n");
3007 Safefree(buff);
3008 return 0;
3009 }
3010 strcpy(imp_sth->proc, tok);
3011 Safefree(buff);
3012 return 1;
3013 }
3014
syb_st_rows(SV * sth,imp_sth_t * imp_sth)3015 int syb_st_rows(SV *sth, imp_sth_t *imp_sth) {
3016 return imp_sth->numRows;
3017 }
3018
cleanUp(imp_sth_t * imp_sth)3019 static void cleanUp(imp_sth_t *imp_sth) {
3020 int i;
3021 int numCols = DBIc_NUM_FIELDS(imp_sth);
3022 for (i = 0; i < numCols; ++i) {
3023 if (imp_sth->coldata[i].type == CS_CHAR_TYPE
3024 || imp_sth->coldata[i].type == CS_LONGCHAR_TYPE
3025 || imp_sth->coldata[i].type == CS_TEXT_TYPE
3026 || imp_sth->coldata[i].type == CS_IMAGE_TYPE) {
3027 Safefree(imp_sth->coldata[i].value.c);
3028 }
3029 }
3030
3031 if (imp_sth->datafmt)
3032 Safefree(imp_sth->datafmt);
3033 if (imp_sth->coldata)
3034 Safefree(imp_sth->coldata);
3035 imp_sth->numCols = 0;
3036 imp_sth->coldata = NULL;
3037 imp_sth->datafmt = NULL;
3038
3039 }
3040
describe(SV * sth,imp_sth_t * imp_sth,int restype)3041 static CS_RETCODE describe(SV *sth, imp_sth_t *imp_sth, int restype) {
3042 dTHX;
3043 D_imp_dbh_from_sth;
3044 CS_RETCODE retcode;
3045 int i;
3046 int numCols;
3047 AV *av;
3048
3049 if ((retcode = ct_res_info(imp_sth->cmd, CS_NUMDATA, &numCols, CS_UNUSED,
3050 NULL)) != CS_SUCCEED) {
3051 warn("ct_res_info() failed");
3052 goto GoodBye;
3053 }
3054 if (numCols <= 0) {
3055 warn("ct_res_info() returned 0 columns");
3056 DBIc_NUM_FIELDS(imp_sth) = numCols;
3057 imp_sth->numCols = 0;
3058 goto GoodBye;
3059 }
3060 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3061 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
3062 " ct_res_info() returns %d columns\n", numCols);
3063
3064 /* According to Tim Bunce I shouldn't need the code below.
3065 However, if I remove it DBD::Sybase segfaults in some situations
3066 with DBI < 1.53, and there are still problems with COMPUTE BY
3067 statements with DBI >= 1.54. */
3068 /* Adjust NUM_OF_FIELDS - which also adjusts the row buffer size */
3069 DBIc_NUM_FIELDS(imp_sth) = 0; /* for DBI <= 1.53 */
3070 DBIc_DBISTATE(imp_sth)->set_attr_k(sth, sv_2mortal(
3071 newSVpvn("NUM_OF_FIELDS", 13)), 0, sv_2mortal(newSViv(numCols)));
3072
3073 #if 1 /* for DBI <= 1.53 (and 1.54 which doesn't shrink properly) */
3074 av = DBIc_FIELDS_AV(imp_sth);
3075 if (av && av_len(av) + 1 != numCols) {
3076 SvREADONLY_off(av); /* DBI sets this readonly */
3077 av_clear(av);
3078 i = numCols;
3079 while (i--) {
3080 av_store(av, i, newSV(0));
3081 }
3082 SvREADONLY_on(av); /* DBI sets this readonly */
3083 }
3084 #endif
3085
3086 imp_sth->numCols = numCols;
3087
3088 New(902, imp_sth->coldata, numCols, ColData);
3089 New(902, imp_sth->datafmt, numCols, CS_DATAFMT);
3090
3091 /* this routine may be called without the connection reference */
3092 if (restype == CS_COMPUTE_RESULT) {
3093 CS_INT comp_id, outlen;
3094
3095 if ((retcode = ct_compute_info(imp_sth->cmd, CS_COMP_ID, CS_UNUSED,
3096 &comp_id, CS_UNUSED, &outlen)) != CS_SUCCEED) {
3097 warn("ct_compute_info failed");
3098 goto GoodBye;
3099 }
3100 }
3101
3102 for (i = 0; i < numCols; ++i) {
3103 if ((retcode = ct_describe(imp_sth->cmd, (i + 1), &imp_sth->datafmt[i]))
3104 != CS_SUCCEED) {
3105 warn("ct_describe() failed");
3106 cleanUp(imp_sth);
3107 goto GoodBye;
3108 }
3109 /* Make sure we have at least some sort of column name: */
3110 if (imp_sth->datafmt[i].namelen == 0)
3111 sprintf(imp_sth->datafmt[i].name, "COL(%d)", i + 1);
3112 if (restype == CS_COMPUTE_RESULT) {
3113 CS_INT agg_op, outlen;
3114 CS_CHAR *agg_op_name;
3115
3116 if ((retcode = ct_compute_info(imp_sth->cmd, CS_COMP_OP, (i + 1),
3117 &agg_op, CS_UNUSED, &outlen)) != CS_SUCCEED) {
3118 warn("ct_compute_info failed");
3119 goto GoodBye;
3120 }
3121 agg_op_name = GetAggOp(agg_op);
3122 if ((retcode = ct_compute_info(imp_sth->cmd, CS_COMP_COLID,
3123 (i + 1), &agg_op, CS_UNUSED, &outlen)) != CS_SUCCEED) {
3124 warn("ct_compute_info failed");
3125 goto GoodBye;
3126 }
3127 sprintf(imp_sth->datafmt[i].name, "%s(%d)", agg_op_name, agg_op);
3128 }
3129
3130 if (DBIc_DBISTATE(imp_dbh)->debug >= 4)
3131 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
3132 " ct_describe(%d): type = %d, maxlen = %d\n", i,
3133 imp_sth->datafmt[i].datatype, imp_sth->datafmt[i].maxlength);
3134
3135 imp_sth->coldata[i].realType = imp_sth->datafmt[i].datatype;
3136 imp_sth->coldata[i].realLength = imp_sth->datafmt[i].maxlength;
3137
3138 imp_sth->datafmt[i].locale = LOCALE(imp_dbh);
3139
3140 switch (imp_sth->datafmt[i].datatype) {
3141 case CS_BIT_TYPE:
3142 case CS_TINYINT_TYPE:
3143 case CS_SMALLINT_TYPE:
3144 case CS_INT_TYPE:
3145 imp_sth->datafmt[i].maxlength = sizeof(CS_INT);
3146 imp_sth->datafmt[i].format = CS_FMT_UNUSED;
3147 imp_sth->coldata[i].type = CS_INT_TYPE;
3148 imp_sth->datafmt[i].datatype = CS_INT_TYPE;
3149 retcode = ct_bind(imp_sth->cmd, (i + 1), &imp_sth->datafmt[i],
3150 &imp_sth->coldata[i].value.i,
3151 &imp_sth->coldata[i].valuelen,
3152 &imp_sth->coldata[i].indicator);
3153 break;
3154
3155 #if defined(SYB_NATIVE_NUM) && defined(CS_UINT_TYPE)
3156 case CS_USMALLINT_TYPE:
3157 case CS_UINT_TYPE:
3158 imp_sth->datafmt[i].maxlength = sizeof(CS_INT);
3159 imp_sth->datafmt[i].format = CS_FMT_UNUSED;
3160 imp_sth->coldata[i].type = CS_UINT_TYPE;
3161 imp_sth->datafmt[i].datatype = CS_UINT_TYPE;
3162 retcode = ct_bind(imp_sth->cmd, (i + 1), &imp_sth->datafmt[i],
3163 &imp_sth->coldata[i].value.ui,
3164 &imp_sth->coldata[i].valuelen,
3165 &imp_sth->coldata[i].indicator);
3166 break;
3167 #endif
3168 #if defined(SYB_NATIVE_NUM)
3169 #if defined(CS_BIGINT_TYPE)
3170 case CS_BIGINT_TYPE:
3171 imp_sth->datafmt[i].maxlength = sizeof(CS_BIGINT);
3172 imp_sth->datafmt[i].format = CS_FMT_UNUSED;
3173 imp_sth->coldata[i].type = CS_BIGINT_TYPE;
3174 imp_sth->datafmt[i].datatype = CS_BIGINT_TYPE;
3175 retcode = ct_bind(imp_sth->cmd, (i + 1), &imp_sth->datafmt[i],
3176 &imp_sth->coldata[i].value.bi,
3177 &imp_sth->coldata[i].valuelen,
3178 &imp_sth->coldata[i].indicator);
3179 break;
3180 #endif
3181 #if defined(CS_UBIGINT_TYPE)
3182 case CS_UBIGINT_TYPE:
3183 imp_sth->datafmt[i].maxlength = sizeof(CS_UBIGINT);
3184 imp_sth->datafmt[i].format = CS_FMT_UNUSED;
3185 imp_sth->coldata[i].type = CS_UBIGINT_TYPE;
3186 imp_sth->datafmt[i].datatype = CS_UBIGINT_TYPE;
3187 retcode = ct_bind(imp_sth->cmd, (i + 1), &imp_sth->datafmt[i],
3188 &imp_sth->coldata[i].value.ubi,
3189 &imp_sth->coldata[i].valuelen,
3190 &imp_sth->coldata[i].indicator);
3191 break;
3192 #endif
3193 #endif
3194
3195 #if defined(SYB_NATIVE_NUM)
3196 case CS_MONEY_TYPE:
3197 case CS_MONEY4_TYPE:
3198 #endif
3199 case CS_REAL_TYPE:
3200 case CS_FLOAT_TYPE:
3201 imp_sth->datafmt[i].maxlength = sizeof(CS_FLOAT);
3202 imp_sth->datafmt[i].format = CS_FMT_UNUSED;
3203 imp_sth->coldata[i].type = CS_FLOAT_TYPE;
3204 imp_sth->datafmt[i].datatype = CS_FLOAT_TYPE;
3205 retcode = ct_bind(imp_sth->cmd, (i + 1), &imp_sth->datafmt[i],
3206 &imp_sth->coldata[i].value.f,
3207 &imp_sth->coldata[i].valuelen,
3208 &imp_sth->coldata[i].indicator);
3209 break;
3210
3211 case CS_TEXT_TYPE:
3212 case CS_IMAGE_TYPE:
3213 #if defined(CS_UNITEXT_TYPE)
3214 case CS_UNITEXT_TYPE:
3215 #endif
3216 New(902, imp_sth->coldata[i].value.c,
3217 imp_sth->datafmt[i].maxlength, char);
3218 imp_sth->datafmt[i].format = CS_FMT_UNUSED; /*CS_FMT_NULLTERM;*/
3219 if (imp_dbh->binaryImage)
3220 imp_sth->coldata[i].type = imp_sth->datafmt[i].datatype;
3221 else {
3222 imp_sth->coldata[i].type = CS_TEXT_TYPE;
3223 imp_sth->datafmt[i].datatype = CS_TEXT_TYPE;
3224 }
3225 if (!imp_sth->noBindBlob) {
3226 retcode = ct_bind(imp_sth->cmd, (i + 1), &imp_sth->datafmt[i],
3227 imp_sth->coldata[i].value.c,
3228 &imp_sth->coldata[i].valuelen,
3229 &imp_sth->coldata[i].indicator);
3230 }
3231 break;
3232
3233 case CS_DATETIME_TYPE:
3234 case CS_DATETIME4_TYPE:
3235 imp_sth->datafmt[i].maxlength = sizeof(CS_DATETIME);
3236 imp_sth->datafmt[i].format = CS_FMT_UNUSED;
3237 imp_sth->coldata[i].type = CS_DATETIME_TYPE;
3238 imp_sth->datafmt[i].datatype = CS_DATETIME_TYPE;
3239 retcode = ct_bind(imp_sth->cmd, (i + 1), &imp_sth->datafmt[i],
3240 &imp_sth->coldata[i].value.dt,
3241 &imp_sth->coldata[i].valuelen,
3242 &imp_sth->coldata[i].indicator);
3243 break;
3244 #if defined(CS_DATE_TYPE)
3245 case CS_DATE_TYPE:
3246 imp_sth->datafmt[i].maxlength = sizeof(CS_DATE);
3247 imp_sth->datafmt[i].format = CS_FMT_UNUSED;
3248 imp_sth->coldata[i].type = CS_DATE_TYPE;
3249 imp_sth->datafmt[i].datatype = CS_DATE_TYPE;
3250 retcode = ct_bind(imp_sth->cmd, (i + 1), &imp_sth->datafmt[i],
3251 &imp_sth->coldata[i].value.d,
3252 &imp_sth->coldata[i].valuelen,
3253 &imp_sth->coldata[i].indicator);
3254 break;
3255 case CS_TIME_TYPE:
3256 imp_sth->datafmt[i].maxlength = sizeof(CS_TIME);
3257 imp_sth->datafmt[i].format = CS_FMT_UNUSED;
3258 imp_sth->coldata[i].type = CS_TIME_TYPE;
3259 imp_sth->datafmt[i].datatype = CS_TIME_TYPE;
3260 retcode = ct_bind(imp_sth->cmd, (i + 1), &imp_sth->datafmt[i],
3261 &imp_sth->coldata[i].value.t,
3262 &imp_sth->coldata[i].valuelen,
3263 &imp_sth->coldata[i].indicator);
3264 break;
3265 #endif
3266
3267 case CS_CHAR_TYPE:
3268 case CS_LONGCHAR_TYPE:
3269 case CS_VARCHAR_TYPE:
3270 case CS_BINARY_TYPE:
3271 case CS_VARBINARY_TYPE:
3272 case CS_NUMERIC_TYPE:
3273 case CS_DECIMAL_TYPE:
3274 default:
3275 imp_sth->datafmt[i].maxlength = get_cwidth(&imp_sth->datafmt[i])
3276 + 1;
3277 /*display_dlen(&imp_sth->datafmt[i]) + 1;*/
3278 imp_sth->datafmt[i].format = CS_FMT_UNUSED;
3279 New(902, imp_sth->coldata[i].value.c,
3280 imp_sth->datafmt[i].maxlength, char);
3281 imp_sth->coldata[i].type = CS_CHAR_TYPE;
3282 imp_sth->datafmt[i].datatype = CS_CHAR_TYPE;
3283 retcode = ct_bind(imp_sth->cmd, (i + 1), &imp_sth->datafmt[i],
3284 imp_sth->coldata[i].value.c, &imp_sth->coldata[i].valuelen,
3285 &imp_sth->coldata[i].indicator);
3286 /* Now that we've accomplished the CHAR actions, set the type back
3287 to BINARY if appropriate, so the useBin0x actions work later. */
3288 if (imp_sth->coldata[i].realType == CS_BINARY_TYPE
3289 || imp_sth->coldata[i].realType == CS_VARBINARY_TYPE) {
3290 imp_sth->coldata[i].type = imp_sth->datafmt[i].datatype
3291 = imp_sth->coldata[i].realType;
3292 }
3293 break;
3294 }
3295 /* check the return code of the call to ct_bind in the
3296 switch above: */
3297 if (retcode != CS_SUCCEED) {
3298 warn("ct_bind() failed");
3299 cleanUp(imp_sth);
3300 break;
3301 }
3302 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3303 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
3304 " describe() -> col %d, type %d, realtype %d\n", i,
3305 imp_sth->coldata[i].type, imp_sth->coldata[i].realType);
3306
3307 }
3308 GoodBye: ;
3309 if (retcode == CS_SUCCEED) {
3310 imp_sth->done_desc = 1;
3311 }
3312 return retcode == CS_SUCCEED;
3313 }
3314
clear_sth_flags(SV * sth,imp_sth_t * imp_sth)3315 static void clear_sth_flags(SV *sth, imp_sth_t *imp_sth) {
3316 D_imp_dbh_from_sth;
3317
3318 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3319 PerlIO_printf(
3320 DBIc_LOGPIO(imp_dbh),
3321 " clear_sth_flags() -> resetting ACTIVE, moreResults, dyn_execed, exec_done\n");
3322 imp_sth->moreResults = 0;
3323 imp_sth->dyn_execed = 0;
3324 imp_sth->exec_done = 0;
3325 if (!imp_sth->connection) {
3326 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3327 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
3328 " clear_sth_flags() -> reset inUse flag\n");
3329 imp_dbh->inUse = 0;
3330 }
3331 }
3332
st_next_result(SV * sth,imp_sth_t * imp_sth)3333 static int st_next_result(SV *sth, imp_sth_t *imp_sth) {
3334 dTHX;
3335 D_imp_dbh_from_sth;
3336 CS_COMMAND *cmd = imp_sth->cmd;
3337 CS_INT restype;
3338 CS_RETCODE retcode;
3339 int failFlag = 0;
3340
3341 imp_sth->numRows = -1;
3342
3343 while ((retcode = ct_results(cmd, &restype)) == CS_SUCCEED) {
3344 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3345 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
3346 " st_next_result() -> ct_results(%d) == %d\n", restype,
3347 retcode);
3348
3349 if (restype == CS_CMD_FAIL)
3350 failFlag = 1;
3351 if ((restype == CS_CMD_DONE || restype == CS_CMD_SUCCEED) && !failFlag) {
3352 ct_res_info(cmd, CS_ROW_COUNT, &imp_sth->numRows, CS_UNUSED, NULL);
3353 }
3354 switch (restype) {
3355 case CS_ROW_RESULT:
3356 case CS_PARAM_RESULT:
3357 case CS_STATUS_RESULT:
3358 case CS_CURSOR_RESULT:
3359 case CS_COMPUTE_RESULT:
3360 if (imp_sth->done_desc) {
3361 cleanUp(imp_sth);
3362 clear_cache(sth, imp_sth);
3363 }
3364 retcode = describe(sth, imp_sth, restype);
3365 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3366 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
3367 "describe() retcode = %d\n", retcode);
3368
3369 if (restype == CS_STATUS_RESULT && (imp_sth->doProcStatus
3370 || (imp_sth->dyn_execed && imp_sth->type == 0))) {
3371 CS_INT rows_read;
3372 retcode = ct_fetch(cmd, CS_UNUSED, CS_UNUSED, CS_UNUSED,
3373 &rows_read);
3374 if (retcode == CS_SUCCEED) {
3375 imp_sth->lastProcStatus = imp_sth->coldata[0].value.i;
3376 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3377 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
3378 "describe() proc status code = %d\n",
3379 imp_sth->lastProcStatus);
3380 if (imp_sth->lastProcStatus != 0) {
3381 failFlag = 2;
3382 }
3383 } else {
3384 croak("ct_fetch() for proc status failed!");
3385 }
3386 while ((retcode = ct_fetch(cmd, CS_UNUSED, CS_UNUSED,
3387 CS_UNUSED, &rows_read))) {
3388 if (retcode == CS_END_DATA || retcode == CS_FAIL)
3389 break;
3390 }
3391 } else
3392 goto Done;
3393 /* exit from the ct_results() loop here if we
3394 are *NOT* in doProcStatus mode, and this is
3395 *NOT* a status result set */
3396 }
3397 }
3398 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3399 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
3400 "ct_results(%d) final retcode = %d\n", restype, retcode);
3401 Done:
3402
3403 /* The lasterr/lastsev is a hack to work around Sybase OpenClient, which
3404 does NOT return CS_CMD_FAIL for constraint errors when
3405 inserting/updating data using ?-style placeholders. */
3406
3407 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3408 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
3409 " st_next_result() -> lasterr = %d, lastsev = %d\n",
3410 imp_dbh->lasterr, imp_dbh->lastsev);
3411
3412 /* Only force a failure if there are no rows to be fetched (ie on a
3413 normal insert/update/delete operation */
3414 if (!failFlag && imp_dbh->lasterr != 0 && imp_dbh->lastsev > 10) {
3415 if (imp_dbh->alwaysForceFailure || (restype != CS_STATUS_RESULT
3416 && restype != CS_ROW_RESULT && restype != CS_PARAM_RESULT
3417 && restype != CS_CURSOR_RESULT && restype != CS_COMPUTE_RESULT)) {
3418
3419 failFlag = 3;
3420 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3421 PerlIO_printf(
3422 DBIc_LOGPIO(imp_dbh),
3423 " st_next_result() -> restype is not data result or syb_cancel_request_on_error is TRUE, force failFlag\n");
3424 } else {
3425 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3426 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
3427 " st_next_result() -> restype is data result, do NOT force failFlag\n");
3428 }
3429 }
3430
3431 /* Cancel the whole thing if we force a failure */
3432 /* Blaise Lepeuple, 9/26/02 */
3433 /* Only do the flush if the failure was forced rather than "normal".
3434 In the normal case the connection is in a stable/idle state */
3435 /* XXX */
3436 if (failFlag && (restype != CS_CMD_DONE && restype != CS_CMD_FAIL)
3437 && retcode != CS_FAIL) {
3438 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3439 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
3440 " st_next_result() -> failFlag set - clear request\n");
3441 syb_st_finish(sth, imp_sth);
3442 }
3443
3444 /* FreeTDS added a result code CS_END_RESULTS */
3445 /* Do the right thing with it Frederick Staats, 6/26/03 */
3446 if (retcode == CS_END_RESULTS)
3447 restype = CS_CMD_DONE;
3448
3449 if (failFlag || retcode == CS_FAIL || retcode == CS_CANCELED) {
3450 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3451 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
3452 " st_next_result() -> force CS_CMD_FAIL return\n");
3453 restype = CS_CMD_FAIL;
3454 }
3455
3456 imp_sth->lastResType = restype;
3457
3458 /* clear the handle here - to be sure to always have a consistent
3459 handle view after command completion. */
3460 if (restype == CS_CMD_DONE || restype == CS_CMD_FAIL) {
3461 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3462 PerlIO_printf(
3463 DBIc_LOGPIO(imp_dbh),
3464 " st_next_result() -> got %s: resetting ACTIVE, moreResults, dyn_execed, exec_done\n",
3465 restype == CS_CMD_DONE ? "CS_CMD_DONE" : "CS_CMD_FAIL");
3466 clear_sth_flags(sth, imp_sth);
3467 DBIc_ACTIVE_off(imp_sth);
3468 } else {
3469 DBIc_ACTIVE_on(imp_sth);
3470 }
3471
3472 return restype;
3473 }
3474
_convert(void * ptr,char * str,CS_LOCALE * locale,CS_DATAFMT * datafmt,CS_INT * len)3475 static int _convert(void *ptr, char *str, CS_LOCALE *locale,
3476 CS_DATAFMT *datafmt, CS_INT *len) {
3477 dTHX;
3478 CS_DATAFMT srcfmt;
3479 CS_INT retcode;
3480 CS_INT reslen;
3481
3482 memset(&srcfmt, 0, sizeof(srcfmt));
3483 srcfmt.datatype = CS_CHAR_TYPE;
3484 srcfmt.maxlength = strlen(str);
3485 srcfmt.format = CS_FMT_NULLTERM;
3486 srcfmt.locale = locale;
3487
3488 retcode = cs_convert(context, &srcfmt, str, datafmt, ptr, &reslen);
3489
3490 /* FIXME - DBIS slow in threaded mode */
3491 if (DBIS->debug >= 3 && retcode != CS_SUCCEED || reslen == CS_UNUSED)
3492 PerlIO_printf(DBILOGFP, "cs_convert failed (_convert(%s, %d))", str,
3493 datafmt->datatype);
3494
3495 if (len) {
3496 *len = reslen;
3497 }
3498
3499 return retcode;
3500 }
3501
get_cs_msg(CS_CONTEXT * context,CS_CONNECTION * connection,char * msg,SV * sth,imp_sth_t * imp_sth)3502 static CS_RETCODE get_cs_msg(CS_CONTEXT *context, CS_CONNECTION *connection,
3503 char *msg, SV *sth, imp_sth_t *imp_sth) {
3504 dTHX;
3505 CS_CLIENTMSG errmsg;
3506 CS_INT lastmsg = 0;
3507 CS_RETCODE ret;
3508
3509 memset((void*) &errmsg, 0, sizeof(CS_CLIENTMSG));
3510 ret = cs_diag(context, CS_STATUS, CS_CLIENTMSG_TYPE, CS_UNUSED, &lastmsg);
3511 if (DBIc_DBISTATE(imp_sth)->debug >= 4)
3512 PerlIO_printf(DBIc_LOGPIO(imp_sth),
3513 "get_cs_msg -> cs_diag(CS_STATUS): lastmsg = %d (ret = %d)\n",
3514 lastmsg, ret);
3515 if (ret != CS_SUCCEED) {
3516 warn("cs_diag(CS_STATUS) failed");
3517 return ret;
3518 }
3519 ret = cs_diag(context, CS_GET, CS_CLIENTMSG_TYPE, lastmsg, &errmsg);
3520 if (DBIc_DBISTATE(imp_sth)->debug >= 4)
3521 PerlIO_printf(DBIc_LOGPIO(imp_sth),
3522 "get_cs_msg -> cs_diag(CS_GET) ret = %d\n", ret);
3523 if (ret != CS_SUCCEED) {
3524 warn("cs_diag(CS_GET) failed");
3525 return ret;
3526 }
3527
3528 DBIh_SET_ERR_CHAR(sth, (imp_xxh_t *)imp_sth, NULL, CS_NUMBER(errmsg.msgnumber),
3529 errmsg.msgstring, NULL, NULL);
3530
3531 if (cslib_cb) {
3532 dSP;
3533 int retval, count;
3534
3535 ENTER;
3536 SAVETMPS;
3537 PUSHMARK(sp);
3538
3539 XPUSHs(sv_2mortal(newSViv(CS_LAYER(errmsg.msgnumber))));
3540 XPUSHs(sv_2mortal(newSViv(CS_ORIGIN(errmsg.msgnumber))));
3541 XPUSHs(sv_2mortal(newSViv(CS_SEVERITY(errmsg.msgnumber))));
3542 XPUSHs(sv_2mortal(newSViv(CS_NUMBER(errmsg.msgnumber))));
3543 XPUSHs(sv_2mortal(newSVpv(errmsg.msgstring, 0)));
3544 if (errmsg.osstringlen > 0)
3545 XPUSHs(sv_2mortal(newSVpv(errmsg.osstring, 0)));
3546 else
3547 XPUSHs(&PL_sv_undef);
3548 if (msg)
3549 XPUSHs(sv_2mortal(newSVpv(msg, 0)));
3550 else
3551 XPUSHs(&PL_sv_undef);
3552
3553 PUTBACK;
3554 if ((count = perl_call_sv(cslib_cb, G_SCALAR)) != 1)
3555 croak("A cslib handler cannot return a LIST");
3556 SPAGAIN;
3557 retval = POPi;
3558
3559 PUTBACK;
3560 FREETMPS;
3561 LEAVE;
3562
3563 return retval == 1 ? CS_SUCCEED : CS_FAIL;
3564 }
3565 #if 0
3566 PerlIO_printf(DBIc_LOGPIO(imp_dbh), "\nCS Library Message:\n");
3567 PerlIO_printf(DBIc_LOGPIO(imp_dbh), "Message number: LAYER = (%ld) ORIGIN = (%ld) ",
3568 CS_LAYER(errmsg.msgnumber), CS_ORIGIN(errmsg.msgnumber));
3569 PerlIO_printf(DBIc_LOGPIO(imp_dbh), "SEVERITY = (%ld) NUMBER = (%ld)\n",
3570 CS_SEVERITY(errmsg.msgnumber), CS_NUMBER(errmsg.msgnumber));
3571 PerlIO_printf(DBIc_LOGPIO(imp_dbh), "Message String: %s\n", errmsg.msgstring);
3572 if(msg)
3573 PerlIO_printf(DBIc_LOGPIO(imp_dbh), "User Message: %s\n", msg);
3574 /*fflush(stderr);*/
3575 #endif
3576 return CS_FAIL;
3577 }
3578
3579 /* Allocate a buffer of the appropriate size for "datatype". Only
3580 works for fixed-size datatypes */
alloc_datatype(CS_INT datatype,int * len)3581 static void * alloc_datatype(CS_INT datatype, int *len) {
3582 void *ptr;
3583 int bytes;
3584
3585 switch (datatype) {
3586 case CS_TINYINT_TYPE:
3587 bytes = sizeof(CS_TINYINT);
3588 break;
3589 case CS_SMALLINT_TYPE:
3590 bytes = sizeof(CS_SMALLINT);
3591 break;
3592 case CS_INT_TYPE:
3593 bytes = sizeof(CS_INT);
3594 break;
3595 case CS_REAL_TYPE:
3596 bytes = sizeof(CS_REAL);
3597 break;
3598 case CS_FLOAT_TYPE:
3599 bytes = sizeof(CS_FLOAT);
3600 break;
3601 case CS_BIT_TYPE:
3602 bytes = sizeof(CS_BIT);
3603 break;
3604 case CS_DATETIME_TYPE:
3605 bytes = sizeof(CS_DATETIME);
3606 break;
3607 case CS_DATETIME4_TYPE:
3608 bytes = sizeof(CS_DATETIME4);
3609 break;
3610 case CS_MONEY_TYPE:
3611 bytes = sizeof(CS_MONEY);
3612 break;
3613 case CS_MONEY4_TYPE:
3614 bytes = sizeof(CS_MONEY4);
3615 break;
3616 case CS_NUMERIC_TYPE:
3617 bytes = sizeof(CS_NUMERIC);
3618 break;
3619 case CS_DECIMAL_TYPE:
3620 bytes = sizeof(CS_DECIMAL);
3621 break;
3622 case CS_LONG_TYPE:
3623 bytes = sizeof(CS_LONG);
3624 break;
3625 #if 0
3626 case CS_SENSITIVITY_TYPE: bytes = sizeof(CS_SENSITIVITY); break;
3627 case CS_BOUNDARY_TYPE: bytes = sizeof(CS_BOUNDARY); break;
3628 #endif
3629 case CS_USHORT_TYPE:
3630 bytes = sizeof(CS_USHORT);
3631 break;
3632 #if defined(CS_DATE_TYPE)
3633 case CS_DATE_TYPE:
3634 bytes = sizeof(CS_DATE);
3635 break;
3636 case CS_TIME_TYPE:
3637 bytes = sizeof(CS_TIME);
3638 break;
3639 #endif
3640 #if defined(CS_BIGINT_TYPE)
3641 case CS_BIGINT_TYPE:
3642 bytes = sizeof(CS_BIGINT);
3643 break;
3644 case CS_USMALLINT_TYPE:
3645 bytes = sizeof(CS_USMALLINT);
3646 break;
3647 case CS_UINT_TYPE:
3648 bytes = sizeof(CS_UINT);
3649 break;
3650 case CS_UBIGINT_TYPE:
3651 bytes = sizeof(CS_UBIGINT);
3652 break;
3653 #endif
3654 default:
3655 warn("alloc_datatype: unkown type: %d", datatype);
3656 return NULL;
3657 }
3658
3659 Newz(902, ptr, bytes, char);
3660 *len = bytes;
3661
3662 return ptr;
3663 }
3664
3665 #if defined(NO_BLK)
syb_blk_execute(imp_dbh_t * imp_dbh,imp_sth_t * imp_sth,SV * sth)3666 static int syb_blk_execute(imp_dbh_t *imp_dbh, imp_sth_t *imp_sth, SV *sth)
3667 {
3668 return -1;
3669 }
3670 #else
syb_blk_execute(imp_dbh_t * imp_dbh,imp_sth_t * imp_sth,SV * sth)3671 static int syb_blk_execute(imp_dbh_t *imp_dbh, imp_sth_t *imp_sth, SV *sth) {
3672 dTHX;
3673 int i;
3674 char name[32];
3675 void *ptr;
3676 CS_CONNECTION *con = imp_sth->connection ? imp_sth->connection
3677 : imp_dbh->connection;
3678 STRLEN slen;
3679 CS_INT vlen;
3680 SV **svp;
3681 phs_t *phs;
3682 CS_RETCODE ret;
3683
3684 #if !defined(USE_CSLIB_CB)
3685 if (cs_diag(context, CS_CLEAR, CS_CLIENTMSG_TYPE, CS_UNUSED, NULL)
3686 != CS_SUCCEED)
3687 warn("cs_diag(CS_CLEAR) failed");
3688 #endif
3689
3690 for (i = 0; i < imp_sth->numCols; ++i) {
3691 sprintf(name, ":p%d", i + 1);
3692 svp = hv_fetch(imp_sth->all_params_hv, name, strlen(name), 0);
3693 phs = ((phs_t*) (void*) SvPVX(*svp));
3694 phs->datafmt.format = CS_FMT_UNUSED;
3695 phs->datafmt.count = 1;
3696 if (!phs->sv || !SvOK(phs->sv) || phs->sv == &PL_sv_undef) {
3697 imp_sth->coldata[i].indicator = 0;
3698 ptr = "";
3699 imp_sth->coldata[i].valuelen = 0;
3700 if (!imp_sth->bcpIdentityFlag && imp_sth->bcpIdentityCol == i + 1)
3701 continue;
3702 } else {
3703 imp_sth->coldata[i].ptr = SvPV(phs->sv, slen);
3704 imp_sth->coldata[i].indicator = 0;
3705
3706 switch (phs->datafmt.datatype) {
3707 #if 0
3708 case CS_NUMERIC_TYPE:
3709 case CS_DECIMAL_TYPE:
3710 if(_convert(&imp_sth->coldata[i].value.num,
3711 imp_sth->coldata[i].ptr, LOCALE(imp_dbh),
3712 &phs->datafmt, &vlen) != CS_SUCCEED) {
3713 /* If the error handler returns CS_FAIL, then FAIL this
3714 row! */
3715 #if !defined(USE_CSLIB_CB)
3716 if(get_cs_msg(context, con) != CS_SUCCEED)
3717 goto FAIL;
3718 #else
3719 warn("BLK _convert(CS_NUMERIC, %s) failed - see cslib error.", imp_sth->coldata[i].ptr);
3720 #endif
3721 }
3722 imp_sth->coldata[i].valuelen = (vlen != CS_UNUSED ? vlen : sizeof(imp_sth->coldata[i].value.num));
3723 ptr = &imp_sth->coldata[i].value.num;
3724 break;
3725 #endif
3726 case CS_BINARY_TYPE:
3727 case CS_LONGBINARY_TYPE:
3728 case CS_LONGCHAR_TYPE:
3729 case CS_TEXT_TYPE:
3730 case CS_IMAGE_TYPE:
3731 case CS_CHAR_TYPE:
3732 /* For these types send data "as is" */
3733 ptr = imp_sth->coldata[i].ptr;
3734 imp_sth->coldata[i].valuelen = slen;
3735 break;
3736 #if defined(CS_UNICHAR_TYPE)
3737 case CS_UNICHAR_TYPE:
3738 /* For these types send data "as is" */
3739 ptr = imp_sth->coldata[i].ptr;
3740 imp_sth->coldata[i].valuelen = slen * 2;
3741 break;
3742 #endif
3743 default:
3744 /* for all others, call cs_convert() before sending */
3745 if (!imp_sth->coldata[i].v_alloc) {
3746 imp_sth->coldata[i].value.p
3747 = alloc_datatype(phs->datafmt.datatype,
3748 &imp_sth->coldata[i].v_alloc);
3749 }
3750 if (_convert(imp_sth->coldata[i].value.p,
3751 imp_sth->coldata[i].ptr, LOCALE(imp_dbh),
3752 &phs->datafmt, &vlen) != CS_SUCCEED) {
3753 char msg[255];
3754 /* If the error handler returns CS_FAIL, then FAIL this
3755 row! */
3756 #if !defined(USE_CSLIB_CB)
3757 sprintf(msg,
3758 "cs_convert failed: column %d: (_convert(%s, %d))",
3759 i + 1, (char *) imp_sth->coldata[i].ptr,
3760 phs->datafmt.datatype);
3761 ret = get_cs_msg(context, con, msg, sth, imp_sth);
3762 if (ret == CS_FAIL)
3763 goto FAIL;
3764 #else
3765 warn("cs_convert failed: column %d: (_convert(%s, %d))",
3766 i + 1, imp_sth->coldata[i].ptr, phs->datafmt.datatype);
3767 ret = CS_FAIL;
3768 goto FAIL;
3769 #endif
3770 }
3771 imp_sth->coldata[i].valuelen = (vlen != CS_UNUSED ? vlen
3772 : imp_sth->coldata[i].v_alloc);
3773 ptr = imp_sth->coldata[i].value.p;
3774 break;
3775 }
3776 }
3777 ret = blk_bind(imp_sth->bcp_desc, i + 1, &phs->datafmt, ptr,
3778 &imp_sth->coldata[i].valuelen, &imp_sth->coldata[i].indicator);
3779 if (DBIc_DBISTATE(imp_dbh)->debug >= 5)
3780 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
3781 "blk_bind %d -> '%s' (ret = %d)\n", i + 1,
3782 imp_sth->coldata[i].ptr, ret);
3783 if (ret != CS_SUCCEED)
3784 goto FAIL;
3785 }
3786
3787 ret = blk_rowxfer(imp_sth->bcp_desc);
3788 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3789 PerlIO_printf(DBIc_LOGPIO(imp_dbh), "blk_rowxfer() -> %d\n", ret);
3790
3791 if (ret == CS_SUCCEED)
3792 imp_sth->bcpRows++;
3793
3794 FAIL: ;
3795 return (ret == CS_SUCCEED ? -1 : -2);
3796 }
3797 #endif
3798
cmd_execute(SV * sth,imp_sth_t * imp_sth)3799 static int cmd_execute(SV *sth, imp_sth_t *imp_sth) {
3800 D_imp_dbh_from_sth;
3801
3802 if (!imp_sth->dyn_execed) {
3803 if (!imp_sth->cmd) {
3804 /* only allocate a CS_COMMAND struct if there isn't one already
3805 bug# 461 */
3806 imp_sth->cmd = syb_alloc_cmd(imp_dbh,
3807 imp_sth->connection ? imp_sth->connection
3808 : imp_dbh->connection);
3809 }
3810 if (ct_command(imp_sth->cmd, CS_LANG_CMD, imp_sth->statement,
3811 CS_NULLTERM, CS_UNUSED) != CS_SUCCEED) {
3812 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3813 PerlIO_printf(
3814 DBIc_LOGPIO(imp_dbh),
3815 " cmd_execute() -> ct_command() failed (cmd=%x, statement=%s, imp_sth=%x)\n",
3816 imp_sth->cmd, imp_sth->statement, imp_sth);
3817 return -2;
3818 }
3819 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3820 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
3821 " cmd_execute() -> ct_command() OK\n");
3822 }
3823
3824 if (ct_send(imp_sth->cmd) != CS_SUCCEED) {
3825 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3826 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
3827 " cmd_execute() -> ct_send() failed\n");
3828
3829 return -2;
3830 }
3831 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3832 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
3833 " cmd_execute() -> ct_send() OK\n");
3834
3835 imp_sth->exec_done = 1;
3836 if (!imp_sth->connection) {
3837 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3838 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
3839 " cmd_execute() -> set inUse flag\n");
3840 imp_dbh->inUse = 1;
3841 }
3842
3843 return 0;
3844 }
3845
syb_st_execute(SV * sth,imp_sth_t * imp_sth)3846 int syb_st_execute(SV *sth, imp_sth_t *imp_sth) {
3847 dTHX;
3848 D_imp_dbh_from_sth;
3849 int restype;
3850
3851 #if 0
3852 /* XXX */
3853 if(DBIc_ACTIVE_KIDS(DBIc_PARENT_COM(imp_sth))) {
3854 /* Need to detect a possible simultaneous call here and
3855 either inhibit it, or open a new connection */
3856 }
3857 #endif
3858
3859 imp_dbh->lasterr = 0;
3860 imp_dbh->lastsev = 0;
3861
3862 if (imp_sth->type == 2) {
3863 return syb_blk_execute(imp_dbh, imp_sth, sth);
3864 }
3865
3866 if (!imp_sth->exec_done) {
3867 /* bind parameters if there are any */
3868 CS_INT rows;
3869 int i;
3870 SV **phs_svp;
3871 char namebuf[30];
3872 int namelen;
3873 phs_t *phs;
3874 int num_params = (int) DBIc_NUM_PARAMS(imp_sth);
3875
3876 int foundOutput = 0;
3877 boundparams_t *params = 0;
3878
3879 /* malloc the maximum possible size for output parameters */
3880 params = malloc(sizeof(boundparams_t) * num_params );
3881
3882 for (i = 1; i <= num_params; ++i) {
3883 sprintf(namebuf, ":p%d", i);
3884 namelen = strlen(namebuf);
3885 phs_svp = hv_fetch(imp_sth->all_params_hv, namebuf, namelen, 0);
3886 if (phs_svp == NULL)
3887 croak("Can't bind unknown placeholder '%s'", namebuf);
3888 phs = (phs_t*) SvPVX(*phs_svp); /* placeholder struct */
3889
3890 /* if the parameter is an output and it is bound as an inout,
3891 * store the pointer, so we can use it for ct_bind */
3892 if ( phs->is_inout && phs->is_boundinout ) {
3893 params[foundOutput].phs = phs;
3894 foundOutput++;
3895 }
3896
3897 if (!_dbd_rebind_ph(sth, imp_sth, phs, 0)) {
3898 free(params);
3899 return -2;
3900 }
3901 }
3902
3903 if (cmd_execute(sth, imp_sth) != 0) {
3904 free(params);
3905 return -2;
3906 }
3907
3908 /* if we have output parameters, fetch the result */
3909 if( foundOutput > 0 ) {
3910 while (ct_results(imp_sth->cmd, &restype) == CS_SUCCEED && restype != CS_CMD_DONE) {
3911 if (restype == CS_CMD_FAIL) {
3912 free(params);
3913 return -2;
3914 }
3915 /* ignore restype == CS_STATUS_RESULT */
3916 if (restype == CS_PARAM_RESULT) {
3917 /* Since we have a parameter result, bind all the output parameters */
3918 for (i = 0; i < foundOutput; i++) {
3919 CS_DATAFMT datafmt;
3920 phs = params[i].phs;
3921 /* find the maxlenght through ct_describe */
3922 if( ct_describe(imp_sth->cmd, i+1, &datafmt) != CS_SUCCEED)
3923 croak("ct_describe() failed");
3924
3925 phs->datafmt.maxlength = datafmt.maxlength;
3926
3927 /* Force to string with SvPOK_only (maybe use SvPV_force ). */
3928 SvPOK_only(phs->sv);
3929 /* grow the output SV to the max length fetch will return */
3930 SvGROW(phs->sv, phs->datafmt.maxlength );
3931
3932 /* bind the SV through pointer to the physical string in the SV,
3933 * store the returned length in the params array for adjustment after fetch */
3934 if( ct_bind(imp_sth->cmd, i+1, &phs->datafmt, SvPVX(phs->sv), ¶ms[i].len, 0) != CS_SUCCEED )
3935 syb_set_error(imp_dbh, -1, "ct_bind() for output param failed!");
3936 }
3937 }
3938
3939 /* fetch all results */
3940 while((ct_fetch(imp_sth->cmd, CS_UNUSED, CS_UNUSED, CS_UNUSED, &rows)) == CS_SUCCEED) {
3941 }
3942 }
3943 /* set the output SV to the correct lenght */
3944 for (i = 0; i < foundOutput; i++) {
3945 SvCUR_set(params[i].phs->sv, params[i].len);
3946 }
3947 }
3948 free(params);
3949 }
3950
3951 restype = st_next_result(sth, imp_sth);
3952
3953 if (restype == CS_CMD_FAIL)
3954 return -2;
3955
3956 return imp_sth->numRows;
3957 }
3958
syb_st_cancel(SV * sth,imp_sth_t * imp_sth)3959 int syb_st_cancel(SV *sth, imp_sth_t *imp_sth) {
3960 D_imp_dbh_from_sth;
3961 CS_CONNECTION *connection = imp_sth->connection ? imp_sth->connection
3962 : imp_dbh->connection;
3963
3964 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
3965 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
3966 " syb_st_cancel() -> ct_cancel(CS_CANCEL_ATTN)\n");
3967
3968 if (ct_cancel(connection, NULL, CS_CANCEL_ATTN) == CS_FAIL) {
3969 ct_close(connection, CS_FORCE_CLOSE);
3970 imp_dbh->isDead = 1;
3971 }
3972
3973 return 1;
3974 }
3975
fix_fbav(imp_sth_t * imp_sth,int num_fields,AV * av)3976 static int fix_fbav(imp_sth_t *imp_sth, int num_fields, AV *av) {
3977 #if 0
3978 int clear_cache = 0;
3979 int i;
3980 D_imp_dbh_from_sth;
3981
3982 if(DBIc_DBISTATE(imp_dbh)->debug >= 3)
3983 PerlIO_printf(DBIc_LOGPIO(imp_dbh), " fix_fbav() -> num_fields = %d, numCols = %d\n", num_fields, imp_sth->numCols);
3984
3985 /* XXX
3986 The code in the if() below is likely to break with new versions
3987 of DBI!!! */
3988 if(num_fields < imp_sth->numCols) {
3989 int isReadonly = SvREADONLY(av);
3990 ++clear_cache;
3991 if(isReadonly)
3992 SvREADONLY_off(av); /* DBI sets this readonly */
3993 i = imp_sth->numCols - 1;
3994 while(i >= num_fields)
3995 av_store(av, i--, newSV(0));
3996 num_fields = AvFILL(av)+1;
3997 if(isReadonly)
3998 SvREADONLY_on(av); /* protect against shift @$row etc */
3999 } else if(num_fields> imp_sth->numCols) {
4000 int isReadonly = SvREADONLY(av);
4001 if(isReadonly)
4002 SvREADONLY_off(av); /* DBI sets this readonly */
4003 av_fill(av, imp_sth->numCols - 1);
4004 num_fields = AvFILL(av)+1;
4005 if(isReadonly)
4006 SvREADONLY_on(av); /* protect against shift @$row etc */
4007 ++clear_cache;
4008 }
4009
4010 return clear_cache;
4011 #else
4012 return 1;
4013 #endif
4014 }
4015
clear_cache(SV * sth,imp_sth_t * imp_sth)4016 static void clear_cache(SV *sth, imp_sth_t *imp_sth) {
4017 dTHX;
4018
4019 /* Code from DBI::DBD */
4020 /* Clear cached statement handle attributes, if necessary */
4021
4022 hv_delete((HV*) SvRV(sth), "NAME", 4, G_DISCARD);
4023 hv_delete((HV*) SvRV(sth), "NULLABLE", 8, G_DISCARD);
4024 hv_delete((HV*) SvRV(sth), "NUM_OF_FIELDS", 13, G_DISCARD);
4025 hv_delete((HV*) SvRV(sth), "PRECISION", 9, G_DISCARD);
4026 hv_delete((HV*) SvRV(sth), "SCALE", 5, G_DISCARD);
4027 hv_delete((HV*) SvRV(sth), "TYPE", 4, G_DISCARD);
4028 }
4029
syb_st_fetch(SV * sth,imp_sth_t * imp_sth)4030 AV * syb_st_fetch(SV *sth, imp_sth_t *imp_sth) {
4031 dTHX;
4032 D_imp_dbh_from_sth;
4033 CS_COMMAND *cmd = imp_sth->cmd;
4034 CS_INT num_fields;
4035 int ChopBlanks;
4036 int i;
4037 AV *av;
4038 CS_RETCODE retcode;
4039 CS_INT rows_read, restype;
4040 int len;
4041
4042 /* Check that execute() was executed sucessfully. This also implies */
4043 /* that describe() executed sucessfuly so the memory buffers */
4044 /* are allocated and bound. */
4045 if (!DBIc_is(imp_sth, DBIcf_ACTIVE) || !imp_sth->exec_done) {
4046 return Nullav;
4047 }
4048
4049 /*
4050 ** Find out how many columns there are in this result set.
4051 */
4052 retcode = ct_res_info(cmd, CS_NUMDATA, &num_fields, CS_UNUSED, NULL);
4053 if (retcode != CS_SUCCEED)
4054 {
4055 croak(" syb_st_fetch(): ct_res_info() failed");
4056 }
4057
4058 ChopBlanks = DBIc_has(imp_sth, DBIcf_ChopBlanks);
4059
4060 TryAgain: retcode = ct_fetch(cmd, CS_UNUSED, CS_UNUSED, CS_UNUSED,
4061 &rows_read);
4062
4063 av = DBIc_DBISTATE(imp_dbh)->get_fbav(imp_sth);
4064
4065 if (DBIc_DBISTATE(imp_dbh)->debug >= 4) {
4066 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4067 " syb_st_fetch() -> ct_fetch() = %d (%d rows, %d cols)\n",
4068 retcode, rows_read, num_fields);
4069 }
4070
4071 switch (retcode) {
4072 case CS_ROW_FAIL:
4073 /* if LongTruncOK is off, then discard this row */
4074 if (!DBIc_is(imp_sth, DBIcf_LongTruncOk))
4075 goto TryAgain;
4076 case CS_SUCCEED:
4077 for (i = 0; i < num_fields; ++i) {
4078 SV *sv = AvARRAY(av)[i]; /* Note: we (re)use the SV in the AV */
4079 len = 0;
4080
4081 if (DBIc_DBISTATE(imp_dbh)->debug >= 5) {
4082 /*char *text = neatsvpv(phs->sv,0);*/
4083 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4084 " syb_st_fetch() -> %d/%d/%d\n", i,
4085 imp_sth->coldata[i].valuelen, imp_sth->coldata[i].type);
4086 }
4087 /* If we're beyond the number of items in this result set
4088 or: the data is null
4089 or: noBindBlob is set and the data type is IMAGE or TEXT
4090 then: set sv to undef */
4091 if (i >= imp_sth->numCols || imp_sth->coldata[i].indicator
4092 == CS_NULLDATA || (imp_sth->noBindBlob
4093 && (imp_sth->datafmt[i].datatype == CS_TEXT_TYPE
4094 || imp_sth->datafmt[i].datatype == CS_IMAGE_TYPE))) {
4095 /* NULL data */
4096 (void) SvOK_off(sv);
4097 } else {
4098 #define DATE_BUFF_LEN 50
4099 char buff[DATE_BUFF_LEN]; /* used for date conversions */
4100
4101 switch (imp_sth->coldata[i].type) {
4102 case CS_IMAGE_TYPE:
4103 case CS_TEXT_TYPE:
4104 case CS_CHAR_TYPE:
4105 case CS_LONGCHAR_TYPE:
4106 len = imp_sth->coldata[i].valuelen;
4107 sv_setpvn(sv, imp_sth->coldata[i].value.c, len);
4108 if ((imp_sth->coldata[i].realType == CS_CHAR_TYPE
4109 || imp_sth->coldata[i].realType == CS_LONGCHAR_TYPE)
4110 && ChopBlanks) {
4111 char *p = SvEND(sv);
4112 int len = SvCUR(sv);
4113 while (len && *--p == ' ')
4114 --len;
4115 if (len != SvCUR(sv)) {
4116 SvCUR_set(sv, len);
4117 *SvEND(sv) = '\0';
4118 }
4119 }
4120 #if defined(DBD_CAN_HANDLE_UTF8)
4121 if (imp_dbh->enable_utf8
4122 && (imp_sth->coldata[i].realType == CS_UNICHAR_TYPE
4123 #if defined(CS_UNITEXT_TYPE)
4124 || imp_sth->coldata[i].realType == CS_UNITEXT_TYPE
4125 #endif
4126 )) {
4127 U8 *value = SvPV_nolen(sv);
4128 STRLEN len = SvCUR(sv);
4129
4130 SvUTF8_off(sv);
4131 if (is_high_bit_set(value, len) && is_utf8_string(value, len)) {
4132 SvUTF8_on(sv);
4133 }
4134 }
4135 #endif
4136 break;
4137 case CS_FLOAT_TYPE:
4138 sv_setnv(sv, imp_sth->coldata[i].value.f);
4139 break;
4140 case CS_INT_TYPE:
4141 sv_setiv(sv, imp_sth->coldata[i].value.i);
4142 break;
4143 #if defined(CS_UINT_TYPE)
4144 case CS_UINT_TYPE:
4145 sv_setnv(sv, imp_sth->coldata[i].value.ui);
4146 break;
4147 #endif
4148 #if defined(CS_BIGINT_TYPE)
4149 case CS_BIGINT_TYPE:
4150 sv_setnv(sv, imp_sth->coldata[i].value.bi);
4151 break;
4152 #endif
4153 #if defined(CS_UBIGINT_TYPE)
4154 case CS_UBIGINT_TYPE:
4155 sv_setnv(sv, imp_sth->coldata[i].value.ubi);
4156 break;
4157 #endif
4158 case CS_BINARY_TYPE:
4159 case CS_VARBINARY_TYPE:
4160 if (imp_dbh->useBin0x) {
4161 /* Add 0x to the front */
4162 sv_setpv(sv, "0x");
4163 } else {
4164 /* stick in empty string so the concat works */
4165 sv_setpv(sv, "");
4166 }
4167 len = imp_sth->coldata[i].valuelen;
4168 sv_catpvn(sv, imp_sth->coldata[i].value.c, len);
4169 break;
4170 case CS_DATETIME_TYPE:
4171 len = datetime2str(&imp_sth->coldata[i].value.dt,
4172 &imp_sth->datafmt[i], buff, DATE_BUFF_LEN,
4173 imp_dbh->dateFmt, LOCALE(imp_dbh));
4174 sv_setpvn(sv, buff, len);
4175 break;
4176 #if defined(CS_DATE_TYPE)
4177 case CS_DATE_TYPE:
4178 len = date2str(&imp_sth->coldata[i].value.d,
4179 &imp_sth->datafmt[i], buff, DATE_BUFF_LEN,
4180 imp_dbh->dateFmt, LOCALE(imp_dbh));
4181 sv_setpvn(sv, buff, len);
4182 break;
4183 case CS_TIME_TYPE:
4184 len = time2str(&imp_sth->coldata[i].value.t,
4185 &imp_sth->datafmt[i], buff, DATE_BUFF_LEN,
4186 imp_dbh->dateFmt, LOCALE(imp_dbh));
4187 sv_setpvn(sv, buff, len);
4188 break;
4189 #endif
4190 default:
4191 croak("syb_st_fetch: unknown datatype: %d, column %d",
4192 imp_sth->datafmt[i].datatype, i + 1);
4193 }
4194 }
4195 }
4196 break;
4197 case CS_FAIL: /* ohmygod */
4198 /* FIXME: Should we call ct_cancel() here, or should we let
4199 the programmer handle it? */
4200 if (ct_cancel(imp_dbh->connection, NULL, CS_CANCEL_ALL) == CS_FAIL) {
4201 ct_close(imp_dbh->connection, CS_FORCE_CLOSE);
4202 imp_dbh->isDead = 1;
4203 }
4204 return Nullav;
4205 break;
4206 case CS_END_DATA: /* we've seen all the data for this result
4207 set. So see if this is the end of the
4208 result sets */
4209
4210 restype = st_next_result(sth, imp_sth);
4211 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
4212 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4213 " syb_st_fetch() -> st_next_results() == %d\n", restype);
4214
4215 if (restype == CS_CMD_DONE || restype == CS_CMD_FAIL) {
4216 return Nullav;
4217 } else { /* XXX What to do here??? */
4218 /* if(fix_fbav(imp_sth, num_fields, av))
4219 clear_cache(sth, imp_sth);*/
4220
4221 if (restype == CS_COMPUTE_RESULT) {
4222 goto TryAgain;
4223 }
4224
4225 imp_sth->moreResults = 1;
4226 }
4227 return Nullav;
4228 break;
4229 case -4: /*TDS_INVALID_PARAMETER:*/
4230 /* XXX is retcode right here */
4231 DBIh_SET_ERR_CHAR(sth, (imp_xxh_t*)imp_sth, Nullch, retcode, "TDS_INVALID_PARAMETER from ct_fetch", Nullch, Nullch);
4232 return Nullav;
4233 case -6: /* TDS_WRONG_STATE: */
4234 /* XXX is retcode right here */
4235 DBIh_SET_ERR_CHAR(sth, (imp_xxh_t*)imp_sth, Nullch, retcode, "TDS_WRONG_STATE from ct_fetch", Nullch, Nullch);
4236 return Nullav;
4237 case CS_CANCELED:
4238 /* XXX is retcode right here */
4239 DBIh_SET_ERR_CHAR(sth, (imp_xxh_t*)imp_sth, Nullch, retcode, "Canceled", Nullch, Nullch);
4240 return Nullav;
4241 default:
4242 warn("ct_fetch() returned an unexpected retcode %ld", (long) retcode);
4243 /* treat as a failure to avoid risk of an endless loop */
4244 DBIh_SET_ERR_CHAR(sth, (imp_xxh_t*)imp_sth, Nullch, retcode, "Unexpected retcode from ct_fetch", Nullch, Nullch);
4245 return Nullav;
4246 }
4247
4248 if (imp_dbh->row_cb) {
4249 dSP;
4250 int retval, count;
4251
4252 ENTER;
4253 SAVETMPS;
4254 PUSHMARK(sp);
4255
4256 XPUSHs(sv_2mortal(newRV((SV*) av)));
4257
4258 PUTBACK;
4259 if ((count = perl_call_sv(imp_dbh->row_cb, G_SCALAR)) != 1)
4260 croak("An error handler can't return a LIST.");
4261 SPAGAIN;
4262 retval = POPi;
4263
4264 PUTBACK;
4265 FREETMPS;
4266 LEAVE;
4267
4268 /* If the called sub returns 0 then we don't return the result set
4269 to the caller, so instead try to fetch the next row... */
4270 if (retval == 0)
4271 goto TryAgain;
4272 }
4273
4274 return av;
4275 }
4276
4277 #if defined(DBD_CAN_HANDLE_UTF8)
is_high_bit_set(const unsigned char * val,STRLEN size)4278 static int is_high_bit_set(const unsigned char *val, STRLEN size)
4279 {
4280 while (*val && size--)
4281 if (*val++ & 0x80) return 1;
4282 return 0;
4283 }
4284 #endif
4285
4286 #if defined(NO_BLK)
sth_blk_finish(imp_dbh_t * imp_dbh,imp_sth_t * imp_sth,SV * sth)4287 static int sth_blk_finish(imp_dbh_t *imp_dbh, imp_sth_t *imp_sth, SV *sth)
4288 {
4289 return 1;
4290 }
4291 #else
sth_blk_finish(imp_dbh_t * imp_dbh,imp_sth_t * imp_sth,SV * sth)4292 static int sth_blk_finish(imp_dbh_t *imp_dbh, imp_sth_t *imp_sth, SV *sth) {
4293 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
4294 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4295 " sth_blk_finish() -> Checking for pending rows\n");
4296 /* If there are any pending rows they should be rolled back, based
4297 on the principle that only *explicitly* commited data should be
4298 kept. */
4299 if (imp_sth->bcpRows > 0) {
4300 if (DBIc_WARN(imp_dbh)) {
4301 warn("finish: %d uncommited rows will be rolled back",
4302 imp_sth->bcpRows);
4303 }
4304 syb_blk_done(imp_sth, CS_BLK_CANCEL);
4305 } else if (imp_sth->bcpRows == 0) {
4306 syb_blk_done(imp_sth, CS_BLK_ALL);
4307 }
4308
4309 blkCleanUp(imp_sth, imp_dbh);
4310 /* Reset autocommit for this handle (see syb_blk_init()) */
4311 DBIc_set(imp_dbh, DBIcf_AutoCommit, imp_sth->bcpAutoCommit);
4312 toggle_autocommit(NULL, imp_dbh, imp_sth->bcpAutoCommit);
4313
4314 clear_sth_flags(sth, imp_sth);
4315
4316 imp_dbh->imp_sth = NULL;
4317
4318 return 1;
4319 }
4320 #endif
4321
syb_st_finish(SV * sth,imp_sth_t * imp_sth)4322 int syb_st_finish(SV *sth, imp_sth_t *imp_sth) {
4323 dTHX;
4324 D_imp_dbh_from_sth;
4325 CS_CONNECTION *connection;
4326
4327 if (imp_sth->bcp_desc) {
4328 return sth_blk_finish(imp_dbh, imp_sth, sth);
4329 }
4330
4331 connection = imp_sth->connection ? imp_sth->connection
4332 : imp_dbh->connection;
4333
4334 /* The SvOK() test is from Henry Asseily. It is there to
4335 avoid a possible infinite loop in the case where the handle
4336 is active, but has been invalidated by OPenSwitch. */
4337 /* Changed to check imp_dbh->lasterr instead */
4338 /* if (imp_dbh->flushFinish && !(SvTRUE(DBIc_ERR(imp_dbh)))) { */
4339 /* if (imp_dbh->flushFinish && !imp_dbh->lasterr) { */
4340 /* It is believed that the fixes applied to st_next_result() makes the
4341 imp_dbh->lasterr check unnecessary */
4342 if (imp_dbh->flushFinish) {
4343 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
4344 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4345 " syb_st_finish() -> flushing\n");
4346 DBIh_CLEAR_ERROR(imp_sth); /* so syb_st_fetch can tell us when something goes wrong */
4347 while (DBIc_ACTIVE(imp_sth) && !imp_dbh->isDead && imp_sth->exec_done
4348 && !SvTRUE(DBIc_ERR(imp_sth))) {
4349 AV *retval;
4350 do {
4351 retval = syb_st_fetch(sth, imp_sth);
4352 } while (retval && retval != Nullav);
4353 }
4354 } else {
4355 if (DBIc_ACTIVE(imp_sth)) {
4356 #if defined(ROGUE)
4357 if(DBIc_DBISTATE(imp_dbh)->debug >= 3)
4358 PerlIO_printf(DBIc_LOGPIO(imp_dbh), " syb_st_finish() -> ct_cancel(CS_CANCEL_CURRENT)\n");
4359 if(ct_cancel(NULL, imp_sth->cmd, CS_CANCEL_CURRENT) == CS_FAIL) {
4360 ct_close(connection, CS_FORCE_CLOSE);
4361 imp_dbh->isDead = 1;
4362 }
4363 #else
4364 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
4365 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4366 " syb_st_finish() -> ct_cancel(CS_CANCEL_ALL)\n");
4367 if (ct_cancel(connection, NULL, CS_CANCEL_ALL) == CS_FAIL) {
4368 ct_close(connection, CS_FORCE_CLOSE);
4369 imp_dbh->isDead = 1;
4370 }
4371 #endif
4372 }
4373 }
4374 clear_sth_flags(sth, imp_sth);
4375 DBIc_ACTIVE_off(imp_sth);
4376 return 1;
4377 }
4378
dealloc_dynamic(imp_sth_t * imp_sth)4379 static void dealloc_dynamic(imp_sth_t *imp_sth) {
4380 dTHX;
4381 CS_RETCODE ret;
4382 CS_INT restype;
4383
4384 if (DBIc_DBISTATE(imp_sth)->debug >= 3)
4385 PerlIO_printf(DBIc_LOGPIO(imp_sth),
4386 " dealloc_dynamic: ct_dynamic(CS_DEALLOC) for %s\n",
4387 imp_sth->dyn_id);
4388
4389 ret = ct_dynamic(imp_sth->cmd, CS_DEALLOC, imp_sth->dyn_id, CS_NULLTERM,
4390 NULL, CS_UNUSED);
4391 if (ret != CS_SUCCEED) {
4392 if (DBIc_DBISTATE(imp_sth)->debug >= 3)
4393 PerlIO_printf(
4394 DBIc_LOGPIO(imp_sth),
4395 " dealloc_dynamic: ct_dynamic(CS_DEALLOC) for %s FAILED\n",
4396 imp_sth->dyn_id);
4397 return;
4398 }
4399 ret = ct_send(imp_sth->cmd);
4400 if (ret != CS_SUCCEED) {
4401 if (DBIc_DBISTATE(imp_sth)->debug >= 3)
4402 PerlIO_printf(DBIc_LOGPIO(imp_sth),
4403 " dealloc_dynamic: ct_send(CS_DEALLOC) for %s FAILED\n",
4404 imp_sth->dyn_id);
4405 return;
4406 }
4407
4408 while (ct_results(imp_sth->cmd, &restype) == CS_SUCCEED)
4409 ;
4410
4411 if (imp_sth->all_params_hv) {
4412 HV *hv = imp_sth->all_params_hv;
4413 SV *sv;
4414 char *key;
4415 I32 retlen;
4416 hv_iterinit(hv);
4417 while ((sv = hv_iternextsv(hv, &key, &retlen)) != NULL) {
4418 if (sv != &PL_sv_undef) {
4419 phs_t *phs_tpl = (phs_t*) (void*) SvPVX(sv);
4420 sv_free(phs_tpl->sv);
4421 }
4422 }
4423 sv_free((SV*) imp_sth->all_params_hv);
4424 }
4425
4426 if (imp_sth->out_params_av)
4427 sv_free((SV*) imp_sth->out_params_av);
4428
4429 imp_sth->all_params_hv = NULL;
4430 imp_sth->out_params_av = NULL;
4431 }
4432
syb_st_destroy(SV * sth,imp_sth_t * imp_sth)4433 void syb_st_destroy(SV *sth, imp_sth_t *imp_sth) {
4434 D_imp_dbh_from_sth;
4435 CS_RETCODE ret;
4436 dTHX;
4437
4438 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
4439 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4440 " syb_st_destroy: called on %x...\n", imp_sth);
4441
4442 if (PL_dirty) {
4443 DBIc_IMPSET_off(imp_sth); /* let DBI know we've done it */
4444 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
4445 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4446 " syb_st_destroy: dirty set, skipping\n");
4447 return;
4448 }
4449
4450 if (DBIc_ACTIVE(imp_dbh))
4451 if (!strncmp(imp_sth->dyn_id, "DBD", 3)) {
4452 dealloc_dynamic(imp_sth);
4453 }
4454
4455 /* moved from the prepare() call - as we need to have this around
4456 to re-execute non-dynamic statements... */
4457 if (imp_sth->statement != NULL) {
4458 if (DBIc_DBISTATE(imp_dbh)->debug >= 3) {
4459 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4460 " syb_st_destroy(): freeing imp_sth->statement\n");
4461 }
4462 Safefree(imp_sth->statement);
4463 imp_sth->statement = NULL;
4464 imp_dbh->sql = NULL;
4465 }
4466
4467 cleanUp(imp_sth);
4468
4469 if (imp_sth->cmd) {
4470 /* Gene Ressler says that this call can fail because we've already
4471 dropped the connection. I'm not sure if this is really a problem
4472 or if it can be ignored. XXX */
4473 if (DBIc_DBISTATE(imp_dbh)->debug >= 4)
4474 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4475 " ct_cmd_drop() -> CS_COMMAND %x\n", imp_sth->cmd);
4476
4477 ret = ct_cmd_drop(imp_sth->cmd);
4478 if (DBIc_DBISTATE(imp_dbh)->debug >= 3) {
4479 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4480 " syb_st_destroy(): cmd dropped: %d\n", ret);
4481 }
4482 }
4483 /* reset BLK data, if needed */
4484 if (imp_sth->bcp_desc) {
4485 /* XXX Should we call blk_done(CS_BLK_ALL) here??? */
4486 if (DBIc_DBISTATE(imp_dbh)->debug >= 3)
4487 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4488 " syb_st_destroy(): blkCleanUp()\n");
4489
4490 sth_blk_finish(imp_dbh, imp_sth, sth);
4491 }
4492 if (imp_sth->connection) {
4493 ret = ct_close(imp_sth->connection, CS_FORCE_CLOSE);
4494 if (DBIc_DBISTATE(imp_dbh)->debug >= 3) {
4495 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4496 " syb_st_destroy(): connection closed: %d\n", ret);
4497 }
4498 ct_con_drop(imp_sth->connection);
4499 } else {
4500 if (DBIc_ACTIVE(imp_sth)) {
4501 if (DBIc_DBISTATE(imp_dbh)->debug >= 3) {
4502 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4503 " syb_st_destroy(): reset inUse flag\n");
4504 }
4505 imp_dbh->inUse = 0;
4506 }
4507 }
4508
4509 DBIc_ACTIVE_off(imp_sth); /* Don't want DBI warning about freeing active handle */
4510 DBIc_IMPSET_off(imp_sth); /* let DBI know we've done it */
4511 }
4512
syb_st_blob_read(SV * sth,imp_sth_t * imp_sth,int field,long offset,long len,SV * destrv,long destoffset)4513 int syb_st_blob_read(SV *sth, imp_sth_t *imp_sth, int field, long offset,
4514 long len, SV *destrv, long destoffset) {
4515 return 1;
4516 }
4517
syb_ct_get_data(SV * sth,imp_sth_t * imp_sth,int column,SV * bufrv,int buflen)4518 int syb_ct_get_data(SV *sth, imp_sth_t *imp_sth, int column, SV *bufrv,
4519 int buflen) {
4520 dTHX;
4521 CS_COMMAND *cmd = imp_sth->cmd;
4522 CS_VOID *buffer;
4523 /* CS_INT buflen = imp_sth->datafmt[column-1].maxlength; */
4524 CS_INT outlen;
4525 CS_RETCODE ret;
4526 SV *bufsv;
4527
4528 if (buflen == 0)
4529 buflen = imp_sth->datafmt[column - 1].maxlength;
4530
4531 if (DBIc_DBISTATE(imp_sth)->debug >= 4)
4532 PerlIO_printf(DBIc_LOGPIO(imp_sth),
4533 " ct_get_data(%d): buflen = %d\n", column, buflen);
4534
4535 /* Fix PR/444: segfault if passed a non-reference SV for buffer */
4536 if (!SvROK(bufrv)) {
4537 warn("ct_get_data: buffer parameter is not a reference!");
4538 return 0;
4539 }
4540 bufsv = SvRV(bufrv);
4541 Newz(902, buffer, buflen, char);
4542
4543 ret = ct_get_data(cmd, column, (CS_VOID*) buffer, buflen, &outlen);
4544 if (outlen) {
4545 sv_setpvn(bufsv, buffer, outlen);
4546 } else {
4547 sv_setsv(bufsv, &PL_sv_undef);
4548 }
4549 if (DBIc_DBISTATE(imp_sth)->debug >= 4)
4550 PerlIO_printf(DBIc_LOGPIO(imp_sth),
4551 " ct_get_data(%d): got %d bytes (ret = %d)\n", column,
4552 outlen, ret);
4553
4554 Safefree(buffer);
4555
4556 return outlen;
4557 }
4558
syb_ct_prepare_send(SV * sth,imp_sth_t * imp_sth)4559 int syb_ct_prepare_send(SV *sth, imp_sth_t *imp_sth) {
4560 return ct_command(imp_sth->cmd, CS_SEND_DATA_CMD, NULL, CS_UNUSED,
4561 CS_COLUMN_DATA) == CS_SUCCEED;
4562 }
4563
syb_ct_finish_send(SV * sth,imp_sth_t * imp_sth)4564 int syb_ct_finish_send(SV *sth, imp_sth_t *imp_sth) {
4565 CS_RETCODE retcode;
4566 CS_INT restype;
4567 D_imp_dbh_from_sth;
4568
4569 retcode = ct_send(imp_sth->cmd);
4570 if (DBIc_DBISTATE(imp_dbh)->debug >= 4)
4571 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4572 " ct_finish_send(): ct_send() = %d\n", retcode);
4573 if (retcode != CS_SUCCEED) {
4574 return 0;
4575 }
4576
4577 while ((retcode = ct_results(imp_sth->cmd, &restype)) == CS_SUCCEED) {
4578 if (DBIc_DBISTATE(imp_dbh)->debug >= 4)
4579 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4580 " ct_finish_send(): ct_results(%d) = %d\n", restype,
4581 retcode);
4582 if (restype == CS_PARAM_RESULT) {
4583 CS_DATAFMT datafmt;
4584 CS_INT count;
4585
4586 retcode = ct_describe(imp_sth->cmd, 1, &datafmt);
4587 if (retcode != CS_SUCCEED) {
4588 if (DBIc_DBISTATE(imp_dbh)->debug >= 4)
4589 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4590 " ct_finish_send(): ct_describe() failed\n");
4591 return 0;
4592 }
4593 datafmt.maxlength = sizeof(imp_dbh->iodesc.timestamp);
4594 datafmt.format = CS_FMT_UNUSED;
4595 if ((retcode = ct_bind(imp_sth->cmd, 1, &datafmt,
4596 (CS_VOID *) imp_dbh->iodesc.timestamp,
4597 &imp_dbh->iodesc.timestamplen, NULL)) != CS_SUCCEED) {
4598 if (DBIc_DBISTATE(imp_dbh)->debug >= 4)
4599 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4600 " ct_finish_send(): ct_bind() failed\n");
4601 return 0;
4602 }
4603 retcode = ct_fetch(imp_sth->cmd, CS_UNUSED, CS_UNUSED, CS_UNUSED,
4604 &count);
4605 if (retcode != CS_SUCCEED) {
4606 if (DBIc_DBISTATE(imp_dbh)->debug >= 4)
4607 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4608 " ct_finish_send(): ct_fetch() failed\n");
4609 return 0;
4610 }
4611 /* success... so cancel the rest of this result set */
4612
4613 retcode = ct_cancel(NULL, imp_sth->cmd, CS_CANCEL_CURRENT);
4614 if (retcode != CS_SUCCEED) {
4615 if (DBIc_DBISTATE(imp_dbh)->debug >= 4)
4616 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4617 " ct_finish_send(): ct_fetch() failed\n");
4618 return 0;
4619 }
4620 }
4621 }
4622
4623 return 1;
4624 }
4625
syb_ct_send_data(SV * sth,imp_sth_t * imp_sth,char * buffer,int size)4626 int syb_ct_send_data(SV *sth, imp_sth_t *imp_sth, char *buffer, int size) {
4627 dTHX;
4628 D_imp_dbh_from_sth;
4629
4630 if (DBIc_DBISTATE(imp_sth)->debug >= 4)
4631 PerlIO_printf(DBIc_LOGPIO(imp_sth),
4632 " ct_send_data(): sending buffer size %d bytes\n", size);
4633 return ct_send_data(imp_sth->cmd, buffer, size) == CS_SUCCEED;
4634 }
4635
syb_ct_data_info(SV * sth,imp_sth_t * imp_sth,int action,int column,SV * attr)4636 int syb_ct_data_info(SV *sth, imp_sth_t *imp_sth, int action, int column,
4637 SV *attr) {
4638 dTHX;
4639 D_imp_dbh_from_sth;
4640 CS_COMMAND *cmd = imp_sth->cmd;
4641 CS_RETCODE ret;
4642
4643 if (action == CS_SET) {
4644 /* we expect the app to maybe modify certain fields of the CS_IODESC
4645 struct. This is done via the attr hash that is passed in here */
4646 if (attr && attr != &PL_sv_undef && SvROK(attr)) {
4647 SV **svp;
4648
4649 svp = hv_fetch((HV*) SvRV(attr), "total_txtlen", 12, 0);
4650 if (svp && SvGMAGICAL(*svp)) /* eg if from tainted expression */
4651 mg_get(*svp);
4652 if (svp && SvIOK(*svp))
4653 imp_dbh->iodesc.total_txtlen = SvIV(*svp);
4654
4655 if (DBIc_DBISTATE(imp_dbh)->debug >= 4)
4656 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4657 " ct_data_info(): set total_txtlen to %d\n",
4658 imp_dbh->iodesc.total_txtlen);
4659
4660 svp = hv_fetch((HV*) SvRV(attr), "log_on_update", 13, 0);
4661 if (svp && SvGMAGICAL(*svp)) /* eg if from tainted expression */
4662 mg_get(*svp);
4663 if (svp && SvIOK(*svp))
4664 imp_dbh->iodesc.log_on_update = SvIV(*svp);
4665 if (DBIc_DBISTATE(imp_dbh)->debug >= 4)
4666 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4667 " ct_data_info(): set log_on_update to %d\n",
4668 imp_dbh->iodesc.log_on_update);
4669 }
4670 }
4671
4672 if (action == CS_SET) {
4673 column = CS_UNUSED;
4674 } else {
4675 if (DBIc_DBISTATE(imp_dbh)->debug >= 4)
4676 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4677 " ct_data_info(): get IODESC for column %d\n", column);
4678 }
4679
4680 ret = ct_data_info(cmd, action, column, &imp_dbh->iodesc);
4681
4682 if (action == CS_GET) {
4683 if (imp_dbh->iodesc.textptrlen == 0) {
4684 DBIh_SET_ERR_CHAR(sth, (imp_xxh_t*)imp_sth, Nullch, 0, "ct_data_info(): text pointer is not set or is undefined. The text/image column may be uninitialized in the database for this row.", Nullch, Nullch);
4685
4686 /*warn("ct_data_info(): text pointer is not set or is undefined. The text/image column may be uninitialized in the database for this row.");*/
4687
4688 return 0;
4689 }
4690
4691 if (DBIc_DBISTATE(imp_dbh)->debug >= 4) {
4692 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
4693 " ct_data_info(): ret = %d, total_txtlen = %d\n", ret,
4694 imp_dbh->iodesc.total_txtlen);
4695 }
4696 } else if (DBIc_DBISTATE(imp_dbh)->debug >= 4) {
4697 PerlIO_printf(DBIc_LOGPIO(imp_dbh), " ct_data_info(): ret = %d\n",
4698 ret);
4699 }
4700
4701 return ret == CS_SUCCEED;
4702 }
4703
4704 /* Borrowed from DBD::ODBC */
4705
4706 typedef struct {
4707 const char *str;
4708 unsigned len :8;
4709 unsigned array :1;
4710 unsigned filler :23;
4711 } T_st_params;
4712
4713 #define s_A(str) { str, sizeof(str)-1 }
4714 static T_st_params S_st_fetch_params[] = { s_A("NUM_OF_PARAMS"), /* 0 */
4715 s_A("NUM_OF_FIELDS"), /* 1 */
4716 s_A("NAME"), /* 2 */
4717 s_A("NULLABLE"), /* 3 */
4718 s_A("TYPE"), /* 4 */
4719 s_A("PRECISION"), /* 5 */
4720 s_A("SCALE"), /* 6 */
4721 s_A("syb_more_results"), /* 7 */
4722 s_A("LENGTH"), /* 8 */
4723 s_A("syb_types"), /* 9 */
4724 s_A("syb_result_type"), /* 10 */
4725 s_A("LongReadLen"), /* 11 */
4726 s_A("syb_proc_status"), /* 12 */
4727 s_A("syb_do_proc_status"), /* 13 */
4728 s_A("syb_no_bind_blob"), /* 14 */
4729 s_A("CursorName"), /* 15 - PR/394 */
4730 s_A(""), /* END */
4731 };
4732
4733 static T_st_params S_st_store_params[] = { s_A("syb_do_proc_status"), /* 0 */
4734 s_A("syb_no_bind_blob"), /* 1 */
4735 s_A(""), /* END */
4736 };
4737 #undef s_A
4738
syb_st_FETCH_attrib(SV * sth,imp_sth_t * imp_sth,SV * keysv)4739 SV * syb_st_FETCH_attrib(SV *sth, imp_sth_t *imp_sth, SV *keysv) {
4740 dTHX;
4741 STRLEN kl;
4742 char *key = SvPV(keysv, kl);
4743 int i;
4744 SV *retsv = NULL;
4745 T_st_params *par;
4746
4747 for (par = S_st_fetch_params; par->len > 0; par++)
4748 if (par->len == kl && strEQ(key, par->str))
4749 break;
4750
4751 if (par->len <= 0)
4752 return Nullsv;
4753
4754 /* NUM_OF_PARAMS is handled by DBI, and the answer is available
4755 even if done_desc is not set. Hence we need to handle this here
4756 rather than in the switch() below. Fixes PR 591, patch
4757 supplied by machj@ders.cz */
4758 if (par - S_st_fetch_params == 0)
4759 return Nullsv; /* handled by DBI */
4760
4761 if (!imp_sth->done_desc && (par - S_st_fetch_params) < 10) {
4762 /* Because of the way Sybase returns information on returned values
4763 in a SELECT statement we can't call describe() here. */
4764 /* Changed Nullsv to PL_sv_undef here to fix PR 541. */
4765 return Nullsv;
4766 }
4767
4768 i = DBIc_NUM_FIELDS(imp_sth);
4769
4770 switch (par - S_st_fetch_params) {
4771 AV *av;
4772
4773 case 0: /* NUM_OF_PARAMS */
4774 return Nullsv; /* handled by DBI */
4775 case 1: /* NUM_OF_FIELDS */
4776 retsv = newSViv(i);
4777 break;
4778 case 2: /* NAME */
4779 av = newAV();
4780 retsv = newRV(sv_2mortal((SV*) av));
4781 while (--i >= 0)
4782 av_store(av, i, newSVpv(imp_sth->datafmt[i].name, 0));
4783 break;
4784 case 3: /* NULLABLE */
4785 av = newAV();
4786 retsv = newRV(sv_2mortal((SV*) av));
4787 while (--i >= 0)
4788 av_store(av, i,
4789 (imp_sth->datafmt[i].status & CS_CANBENULL) ? newSViv(1)
4790 : newSViv(0));
4791 break;
4792 case 4: /* TYPE */
4793 av = newAV();
4794 retsv = newRV(sv_2mortal((SV*) av));
4795 while (--i >= 0)
4796 av_store(av, i, newSViv(map_syb_types(imp_sth->coldata[i].realType)));
4797 break;
4798 case 5: /* PRECISION */
4799 av = newAV();
4800 retsv = newRV(sv_2mortal((SV*) av));
4801 while (--i >= 0)
4802 av_store(av, i, newSViv(
4803 imp_sth->datafmt[i].precision ? imp_sth->datafmt[i].precision
4804 : imp_sth->coldata[i].realLength));
4805 break;
4806 case 6: /* SCALE */
4807 av = newAV();
4808 retsv = newRV(sv_2mortal((SV*) av));
4809 while (--i >= 0) {
4810 switch (imp_sth->coldata[i].realType) {
4811 case CS_NUMERIC_TYPE:
4812 case CS_DECIMAL_TYPE:
4813 av_store(av, i, newSViv(imp_sth->datafmt[i].scale));
4814 break;
4815 default:
4816 av_store(av, i, newSVsv(&PL_sv_undef));
4817 }
4818 }
4819 break;
4820 case 7:
4821 retsv = newSViv(imp_sth->moreResults);
4822 break;
4823 case 8:
4824 av = newAV();
4825 retsv = newRV(sv_2mortal((SV*) av));
4826 while (--i >= 0)
4827 av_store(av, i, newSViv(imp_sth->coldata[i].realLength));
4828 break;
4829 case 9: /* syb_types: native datatypes */
4830 av = newAV();
4831 retsv = newRV(sv_2mortal((SV*) av));
4832 while (--i >= 0)
4833 av_store(av, i, newSViv(imp_sth->coldata[i].realType));
4834 break;
4835 case 10:
4836 retsv = newSViv(imp_sth->lastResType);
4837 break;
4838 case 11:
4839 retsv = newSViv(DBIc_LongReadLen(imp_sth));
4840 break;
4841 case 12:
4842 retsv = newSViv(imp_sth->lastProcStatus);
4843 break;
4844 case 13:
4845 retsv = newSViv(imp_sth->doProcStatus);
4846 break;
4847 case 14:
4848 retsv = newSViv(imp_sth->noBindBlob);
4849 break;
4850 case 15:
4851 retsv = &PL_sv_undef; /* fix for PR/394 */
4852 break;
4853 default:
4854 return Nullsv;
4855 }
4856
4857 if (retsv == &PL_sv_no || retsv == &PL_sv_yes || retsv == &PL_sv_undef)
4858 return retsv;
4859
4860 return sv_2mortal(retsv);
4861 }
4862
syb_st_STORE_attrib(SV * sth,imp_sth_t * imp_sth,SV * keysv,SV * valuesv)4863 int syb_st_STORE_attrib(SV *sth, imp_sth_t *imp_sth, SV *keysv, SV *valuesv) {
4864 dTHX;
4865 STRLEN kl;
4866 char *key = SvPV(keysv, kl);
4867 T_st_params *par;
4868
4869 if (DBIc_DBISTATE(imp_sth)->debug >= 3) {
4870 PerlIO_printf(DBIc_LOGPIO(imp_sth), " syb_st_STORE(): key = %s\n",
4871 key);
4872 }
4873
4874 for (par = S_st_store_params; par->len > 0; par++)
4875 if (par->len == kl && strEQ(key, par->str))
4876 break;
4877
4878 if (par->len <= 0)
4879 return FALSE;
4880
4881 if (DBIc_DBISTATE(imp_sth)->debug >= 3) {
4882 PerlIO_printf(DBIc_LOGPIO(imp_sth),
4883 " syb_st_STORE(): storing %d for key = %s\n",
4884 SvTRUE(valuesv), key);
4885 }
4886 switch (par - S_st_store_params) {
4887 case 0:
4888 if (SvTRUE(valuesv)) {
4889 imp_sth->doProcStatus = 1;
4890 } else {
4891 imp_sth->doProcStatus = 0;
4892 }
4893 return TRUE;
4894 case 1:
4895 if (SvTRUE(valuesv)) {
4896 imp_sth->noBindBlob = 1;
4897 } else {
4898 imp_sth->noBindBlob = 0;
4899 }
4900 return TRUE;
4901 }
4902 return FALSE;
4903 }
4904
datetime2str(CS_DATETIME * dt,CS_DATAFMT * srcfmt,char * buff,CS_INT len,int type,CS_LOCALE * locale)4905 static int datetime2str(CS_DATETIME *dt, CS_DATAFMT *srcfmt, char *buff,
4906 CS_INT len, int type, CS_LOCALE *locale) {
4907 if (type == 0) {
4908 CS_DATAFMT dstfmt;
4909
4910 memset(&dstfmt, 0, sizeof(dstfmt));
4911 dstfmt.datatype = CS_CHAR_TYPE;
4912 dstfmt.maxlength = len;
4913 dstfmt.format = CS_FMT_NULLTERM;
4914 dstfmt.locale = locale;
4915 cs_convert(context, srcfmt, dt, &dstfmt, buff, &len);
4916
4917 return len - 1;
4918 } else {
4919 CS_DATEREC rec;
4920 cs_dt_crack(context, CS_DATETIME_TYPE, dt, &rec);
4921 if (type == 2) {
4922 sprintf(buff, "%4.4d-%2.2d-%2.2dT%2.2d:%2.2d:%2.2d.%3.3dZ",
4923 rec.dateyear, rec.datemonth + 1, rec.datedmonth,
4924 rec.datehour, rec.dateminute, rec.datesecond,
4925 rec.datemsecond);
4926 } else {
4927 sprintf(buff, "%4.4d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d.%3.3d",
4928 rec.dateyear, rec.datemonth + 1, rec.datedmonth,
4929 rec.datehour, rec.dateminute, rec.datesecond,
4930 rec.datemsecond);
4931 }
4932
4933 return strlen(buff);
4934 }
4935
4936 return 0;
4937 }
4938
4939 #if defined(CS_DATE_TYPE)
date2str(CS_DATE * d,CS_DATAFMT * srcfmt,char * buff,CS_INT len,int type,CS_LOCALE * locale)4940 static int date2str(CS_DATE *d, CS_DATAFMT *srcfmt, char *buff, CS_INT len,
4941 int type, CS_LOCALE *locale) {
4942 if (type == 0) {
4943 CS_DATAFMT dstfmt;
4944
4945 memset(&dstfmt, 0, sizeof(dstfmt));
4946 dstfmt.datatype = CS_CHAR_TYPE;
4947 dstfmt.maxlength = len;
4948 dstfmt.format = CS_FMT_NULLTERM;
4949 dstfmt.locale = locale;
4950 cs_convert(context, srcfmt, d, &dstfmt, buff, &len);
4951
4952 return len - 1;
4953 } else {
4954 CS_DATEREC rec;
4955 cs_dt_crack(context, CS_DATE_TYPE, d, &rec);
4956 if (type == 2) {
4957 sprintf(buff, "%4.4d-%2.2d-%2.2dT%2.2d:%2.2d:%2.2d.%3.3dZ",
4958 rec.dateyear, rec.datemonth + 1, rec.datedmonth,
4959 rec.datehour, rec.dateminute, rec.datesecond,
4960 rec.datemsecond);
4961 } else {
4962 sprintf(buff, "%4.4d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d.%3.3d",
4963 rec.dateyear, rec.datemonth + 1, rec.datedmonth,
4964 rec.datehour, rec.dateminute, rec.datesecond,
4965 rec.datemsecond);
4966 }
4967
4968 return strlen(buff);
4969 }
4970
4971 return 0;
4972 }
4973
time2str(CS_TIME * t,CS_DATAFMT * srcfmt,char * buff,CS_INT len,int type,CS_LOCALE * locale)4974 static int time2str(CS_TIME *t, CS_DATAFMT *srcfmt, char *buff, CS_INT len,
4975 int type, CS_LOCALE *locale) {
4976 if (type == 0) {
4977 CS_DATAFMT dstfmt;
4978
4979 memset(&dstfmt, 0, sizeof(dstfmt));
4980 dstfmt.datatype = CS_CHAR_TYPE;
4981 dstfmt.maxlength = len;
4982 dstfmt.format = CS_FMT_NULLTERM;
4983 dstfmt.locale = locale;
4984 cs_convert(context, srcfmt, t, &dstfmt, buff, &len);
4985
4986 return len - 1;
4987 } else {
4988 CS_DATEREC rec;
4989 cs_dt_crack(context, CS_TIME_TYPE, t, &rec);
4990 if (type == 2) {
4991 sprintf(buff, "%4.4d-%2.2d-%2.2dT%2.2d:%2.2d:%2.2d.%3.3dZ",
4992 rec.dateyear, rec.datemonth + 1, rec.datedmonth,
4993 rec.datehour, rec.dateminute, rec.datesecond,
4994 rec.datemsecond);
4995 } else {
4996 sprintf(buff, "%4.4d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d.%3.3d",
4997 rec.dateyear, rec.datemonth + 1, rec.datedmonth,
4998 rec.datehour, rec.dateminute, rec.datesecond,
4999 rec.datemsecond);
5000 }
5001
5002 return strlen(buff);
5003 }
5004
5005 return 0;
5006 }
5007 #endif
5008
to_numeric(char * str,CS_LOCALE * locale,CS_DATAFMT * datafmt,int type)5009 static CS_NUMERIC to_numeric(char *str, CS_LOCALE *locale, CS_DATAFMT *datafmt,
5010 int type) {
5011 CS_NUMERIC mn;
5012 CS_DATAFMT srcfmt;
5013 CS_INT reslen;
5014 char *p;
5015
5016 memset(&mn, 0, sizeof(mn));
5017
5018 if (!str || !*str)
5019 str = "0";
5020
5021 /* warn("to_money(%s)\n", str); */
5022
5023 memset(&srcfmt, 0, sizeof(srcfmt));
5024 srcfmt.datatype = CS_CHAR_TYPE;
5025 srcfmt.maxlength = strlen(str);
5026 srcfmt.format = CS_FMT_NULLTERM;
5027 srcfmt.locale = locale;
5028
5029 if (type) { /* RPC call */
5030 if ((p = strchr(str, '.')))
5031 datafmt->scale = strlen(p + 1);
5032 else
5033 datafmt->scale = 0;
5034 datafmt->precision = strlen(str);
5035 } else { /* dynamic SQL */
5036 /* If the number of digits after the . is larger than
5037 the 'scale' value in datafmt, then we need to adjust it. Otherwise
5038 the conversion fails */
5039 if ((p = strchr(str, '.'))) {
5040 int len = strlen(++p);
5041 if (len > datafmt->scale) {
5042 if (p[datafmt->scale] < '5')
5043 p[datafmt->scale] = 0;
5044 else {
5045 p[datafmt->scale] = 0;
5046 len = strlen(str);
5047 while (len--) {
5048 if (str[len] == '.')
5049 continue;
5050 if (str[len] < '9') {
5051 str[len]++;
5052 break;
5053 }
5054 str[len] = '0';
5055 if (len == 0) {
5056 char buf[64];
5057 buf[0] = '1';
5058 buf[1] = 0;
5059 strcat(buf, str);
5060 strcpy(str, buf);
5061 break;
5062 }
5063 }
5064 }
5065 }
5066 }
5067 }
5068
5069 if (cs_convert(context, &srcfmt, str, datafmt, &mn, &reslen) != CS_SUCCEED)
5070 warn("cs_convert failed (to_numeric(%s))", str);
5071
5072 if (reslen == CS_UNUSED)
5073 warn("conversion failed: to_numeric(%s)", str);
5074
5075 return mn;
5076 }
5077
to_money(char * str,CS_LOCALE * locale)5078 static CS_MONEY to_money(char *str, CS_LOCALE *locale) {
5079 CS_MONEY mn;
5080 CS_DATAFMT srcfmt, destfmt;
5081 CS_INT reslen;
5082
5083 memset(&mn, 0, sizeof(mn));
5084
5085 if (!str)
5086 return mn;
5087
5088 memset(&srcfmt, 0, sizeof(srcfmt));
5089 srcfmt.datatype = CS_CHAR_TYPE;
5090 srcfmt.maxlength = strlen(str);
5091 srcfmt.format = CS_FMT_NULLTERM;
5092 srcfmt.locale = locale;
5093
5094 memset(&destfmt, 0, sizeof(destfmt));
5095
5096 destfmt.datatype = CS_MONEY_TYPE;
5097 destfmt.locale = locale;
5098 destfmt.maxlength = sizeof(CS_MONEY);
5099 destfmt.format = CS_FMT_UNUSED;
5100
5101 if (cs_convert(context, &srcfmt, str, &destfmt, &mn, &reslen) != CS_SUCCEED)
5102 warn("cs_convert failed (to_money(%s))", str);
5103
5104 if (reslen == CS_UNUSED)
5105 warn("conversion failed: to_money(%s)", str);
5106
5107 return mn;
5108 }
5109
to_binary(char * str,STRLEN * outlen)5110 static CS_BINARY * to_binary(char *str, STRLEN *outlen) {
5111 CS_BINARY *b, *b_ptr;
5112 char s[3], *strtol_end;
5113 STRLEN i, b_len;
5114 long int x;
5115
5116 /* Advance past the 0x. We could use the value of syb_use_bin_0x
5117 to infer whether to advance or not, but it's just as easy to
5118 explicitly check. */
5119 if (str[0] == '0' && str[1] == 'x')
5120 str += 2;
5121
5122 /* The length of 'str' _should_ be even, but we go thru some acrobatics
5123 to handle an odd length. We won't flag it as invalid, just pretend
5124 it's okay. */
5125 b_len = (strlen(str) + 1) / 2;
5126 b = (CS_BINARY *) safemalloc(b_len);
5127 memset(b, 0, b_len);
5128 memset(&s, '\0', 3);
5129
5130 /* Pack the characters */
5131 b_ptr = b;
5132 for (i = 0; i < b_len; i++, str += 2) {
5133 strncpy(s, str, 2);
5134 x = strtol(s, &strtol_end, 16);
5135 if (*strtol_end != '\0') {
5136 warn("conversion failed: invalid char '%c'", *strtol_end);
5137 break;
5138 }
5139 *b_ptr++ = x;
5140 }
5141 *outlen = b_len;
5142
5143 return b;
5144 }
5145
_dbd_rebind_ph(SV * sth,imp_sth_t * imp_sth,phs_t * phs,int maxlen)5146 static int _dbd_rebind_ph(SV *sth, imp_sth_t *imp_sth, phs_t *phs, int maxlen) {
5147 dTHX;
5148 D_imp_dbh_from_sth;
5149 CS_RETCODE rc;
5150 STRLEN value_len;
5151 int i_value;
5152 double d_value;
5153 void *value;
5154 CS_NUMERIC n_value;
5155 CS_MONEY m_value;
5156 CS_INT datatype;
5157 int free_value = 0;
5158
5159 if (DBIc_DBISTATE(imp_dbh)->debug >= 3) {
5160 char *text = neatsvpv(phs->sv, 0);
5161 PerlIO_printf(DBIc_LOGPIO(imp_dbh), " bind %s (%s) <== %s (",
5162 phs->name, phs->varname, text);
5163 if (SvOK(phs->sv))
5164 PerlIO_printf(DBIc_LOGPIO(imp_dbh), "size %ld/%ld/%ld, ",
5165 (long) SvCUR(phs->sv), (long) SvLEN(phs->sv), phs->maxlen);
5166 else
5167 PerlIO_printf(DBIc_LOGPIO(imp_dbh), "NULL, ");
5168 PerlIO_printf(DBIc_LOGPIO(imp_dbh), "ptype %d, otype %d%s)\n",
5169 (int) SvTYPE(phs->sv), phs->ftype, (phs->is_inout) ? ", inout"
5170 : "");
5171 }
5172
5173 /* At the moment we always do sv_setsv() and rebind. */
5174 /* Later we may optimise this so that more often we can */
5175 /* just copy the value & length over and not rebind. */
5176 #if 0
5177 if (phs->is_inout) { /* XXX */
5178 if (SvREADONLY(phs->sv))
5179 croak(no_modify);
5180 /* phs->sv _is_ the real live variable, it may 'mutate' later */
5181 /* pre-upgrade high to reduce risk of SvPVX realloc/move */
5182 (void)SvUPGRADE(phs->sv, SVt_PVNV);
5183 /* ensure room for result, 28 is magic number (see sv_2pv) */
5184 SvGROW(phs->sv, (phs->maxlen < 28) ? 28 : phs->maxlen+1);
5185 }
5186 else {
5187 /* phs->sv is copy of real variable, upgrade to at least string */
5188 (void)SvUPGRADE(phs->sv, SVt_PV);
5189 }
5190 #else
5191 /* phs->sv is copy of real variable, upgrade to at least string */
5192 (void) SvUPGRADE(phs->sv, SVt_PV);
5193 #endif
5194
5195 /* At this point phs->sv must be at least a PV with a valid buffer, */
5196 /* even if it's undef (null) */
5197 /* Here we set phs->sv_buf, and value_len. */
5198
5199 /* determine the value, and length that we wish to pass to
5200 ct_param() */
5201 datatype = phs->datafmt.datatype;
5202
5203 if (SvOK(phs->sv)) {
5204 phs->sv_buf = SvPV(phs->sv, value_len);
5205
5206 switch (phs->datafmt.datatype) {
5207 case CS_INT_TYPE:
5208 case CS_SMALLINT_TYPE:
5209 case CS_TINYINT_TYPE:
5210 case CS_BIT_TYPE:
5211 phs->datafmt.datatype = CS_INT_TYPE;
5212 i_value = atoi(phs->sv_buf);
5213 value = &i_value;
5214 value_len = 4;
5215 break;
5216 case CS_NUMERIC_TYPE:
5217 case CS_DECIMAL_TYPE:
5218 n_value = to_numeric(phs->sv_buf, LOCALE(imp_dbh), &phs->datafmt,
5219 imp_sth->type);
5220 phs->datafmt.datatype = CS_NUMERIC_TYPE;
5221 value = &n_value;
5222 value_len = sizeof(n_value);
5223 break;
5224 case CS_MONEY_TYPE:
5225 case CS_MONEY4_TYPE:
5226 m_value = to_money(phs->sv_buf, LOCALE(imp_dbh));
5227 phs->datafmt.datatype = CS_MONEY_TYPE;
5228 value = &m_value;
5229 value_len = sizeof(m_value);
5230 break;
5231 case CS_REAL_TYPE:
5232 case CS_FLOAT_TYPE:
5233 phs->datafmt.datatype = CS_FLOAT_TYPE;
5234 d_value = atof(phs->sv_buf);
5235 value = &d_value;
5236 value_len = sizeof(double);
5237 break;
5238 case CS_BINARY_TYPE:
5239 /* If this binary value is in hex format, with or without the
5240 leading 0x, then convert to actual binary value.
5241 Fix contributed by Tim Ayers */
5242 phs->datafmt.datatype = CS_BINARY_TYPE;
5243 if ((phs->sv_buf[0] == '0' && phs->sv_buf[1] == 'x') || strspn(
5244 phs->sv_buf, "abcdefABCDEF0123456789") == value_len) {
5245 value = to_binary(phs->sv_buf, &value_len);
5246 /*warn("Got value = '%s'\n", value);*/
5247 ++free_value;
5248 } else {
5249 value = phs->sv_buf;
5250 }
5251 /* value_len = SvCUR(phs->sv_buf); */
5252 break;
5253 case CS_DATETIME_TYPE:
5254 case CS_DATETIME4_TYPE:
5255 phs->datafmt.datatype = CS_CHAR_TYPE;
5256 value = phs->sv_buf;
5257 value_len = CS_NULLTERM;
5258 /* PR/464: datetime values get converted to "jan 1 1900" if turned
5259 into a single space */
5260 if (*(char*) value == 0) {
5261 value = NULL;
5262 value_len = CS_UNUSED;
5263 }
5264 break;
5265
5266 default:
5267 phs->datafmt.datatype = CS_CHAR_TYPE;
5268 value = phs->sv_buf;
5269 /*value_len = CS_NULLTERM;*//*Allow embedded NUL bytes in strings?*/
5270 /* PR/446: should an empty string cause a NULL, or not? */
5271 if (*(char*) value == 0) {
5272 if (imp_dbh->bindEmptyStringNull) {
5273 value = NULL;
5274 value_len = CS_UNUSED;
5275 } else {
5276 value = " ";
5277 value_len = CS_NULLTERM; /* PR/624 */
5278
5279 }
5280 }
5281 break;
5282 }
5283 } else { /* it's null but point to buffer incase it's an out var */
5284 phs->sv_buf = SvPVX(phs->sv);
5285 value_len = 0;
5286 value = NULL;
5287 }
5288 phs->sv_type = SvTYPE(phs->sv); /* part of mutation check */
5289 phs->maxlen = SvLEN(phs->sv) - 1; /* avail buffer space */
5290 /* value_len has current value length */
5291
5292 if (DBIc_DBISTATE(imp_dbh)->debug >= 4) {
5293 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
5294 " bind %s <== '%.100s' (size %d, ok %d)\n", phs->name,
5295 phs->sv_buf, (long) phs->maxlen, SvOK(phs->sv) ? 1 : 0);
5296 }
5297 if (DBIc_DBISTATE(imp_dbh)->debug >= 4) {
5298 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
5299 " datafmt: type=%d, name=%s, status=%d, len=%d\n",
5300 phs->datafmt.datatype, phs->datafmt.name, phs->datafmt.status,
5301 value_len);
5302 PerlIO_printf(DBIc_LOGPIO(imp_dbh), " saved type: %d\n", datatype);
5303 }
5304
5305 #if 0
5306 /* If this handle is still active call finish()... */
5307 if(DBIc_ACTIVE(imp_sth) && imp_sth->exec_done) {
5308 int finish = imp_dbh->flushFinish;
5309 imp_dbh->flushFinish = 1;
5310 syb_st_finish(sth, imp_sth);
5311 imp_dbh->flushFinish = finish;
5312 }
5313 #endif
5314
5315 if (imp_sth->dyn_execed == 0) {
5316 if (imp_sth->type == 0) {
5317 if (ct_dynamic(imp_sth->cmd, CS_EXECUTE, imp_sth->dyn_id,
5318 CS_NULLTERM, NULL, CS_UNUSED) != CS_SUCCEED)
5319 return 0;
5320 } else if (imp_sth->type == 1) {
5321 if (ct_command(imp_sth->cmd, CS_RPC_CMD, imp_sth->proc,
5322 CS_NULLTERM, CS_NO_RECOMPILE) != CS_SUCCEED) {
5323 char errbuf[1024];
5324 sprintf(errbuf, "ct_command(CS_RPC_CMD, %s) failed\n",
5325 imp_sth->proc);
5326 syb_set_error(imp_dbh, -1, errbuf);
5327 return 0;
5328 }
5329 }
5330 imp_sth->dyn_execed = 1;
5331 }
5332
5333 if ((rc = ct_param(imp_sth->cmd, &phs->datafmt, value, value_len, 0))
5334 != CS_SUCCEED)
5335 syb_set_error(imp_dbh, -1, "ct_param() failed!");
5336
5337 phs->datafmt.datatype = datatype;
5338
5339 if (free_value && value != NULL)
5340 Safefree(value);
5341
5342 return (rc == CS_SUCCEED);
5343 }
5344
syb_bind_ph(SV * sth,imp_sth_t * imp_sth,SV * ph_namesv,SV * newvalue,IV sql_type,SV * attribs,int is_inout,IV maxlen)5345 int syb_bind_ph(SV *sth, imp_sth_t *imp_sth, SV *ph_namesv, SV *newvalue,
5346 IV sql_type, SV *attribs, int is_inout, IV maxlen) {
5347 dTHX;
5348 SV **phs_svp;
5349 STRLEN name_len;
5350 char *name;
5351 char namebuf[30];
5352 phs_t *phs;
5353 STRLEN lna;
5354 D_imp_dbh_from_sth;
5355
5356 #if 1
5357 /* If this handle is still active call finish()... */
5358 if (DBIc_ACTIVE(imp_sth) && imp_sth->exec_done) {
5359 int finish = imp_dbh->flushFinish;
5360 imp_dbh->flushFinish = 1;
5361 syb_st_finish(sth, imp_sth);
5362 imp_dbh->flushFinish = finish;
5363 }
5364 #endif
5365
5366 /* This is the way Tim does it in DBD::Oracle to get around the
5367 tainted issue. */
5368 if (SvGMAGICAL(ph_namesv)) /* eg if from tainted expression */
5369 mg_get(ph_namesv);
5370 if (!SvNIOKp(ph_namesv)) {
5371 name = SvPV(ph_namesv, name_len);
5372 }
5373 if (SvNIOKp(ph_namesv) || (name && isDIGIT(name[0]))) {
5374 sprintf(namebuf, ":p%d", (int) SvIV(ph_namesv));
5375 name = namebuf;
5376 name_len = strlen(name);
5377 }
5378
5379 if (SvTYPE(newvalue) > SVt_PVLV) /* hook for later array logic */
5380 croak("Can't bind non-scalar value (currently)");
5381 #if 0
5382 if (SvTYPE(newvalue) == SVt_PVLV && is_inout) /* may allow later */
5383 croak("Can't bind ``lvalue'' mode scalar as inout parameter (currently)");
5384 #endif
5385
5386 if (DBIc_DBISTATE(imp_sth)->debug >= 3)
5387 PerlIO_printf(DBIc_LOGPIO(imp_sth),
5388 "bind %s <== '%.200s' (attribs: %s)\n", name, SvPV(newvalue,
5389 lna), attribs ? SvPV(attribs, lna) : "");
5390
5391 phs_svp = hv_fetch(imp_sth->all_params_hv, name, name_len, 0);
5392 if (phs_svp == NULL)
5393 croak("Can't bind unknown placeholder '%s'", name);
5394 phs = (phs_t*) SvPVX(*phs_svp); /* placeholder struct */
5395
5396 if (DBIc_DBISTATE(imp_sth)->debug >= 3)
5397 PerlIO_printf(DBIc_LOGPIO(imp_sth), " parameter is output [%s]\n", is_inout ? "true" : "false" );
5398
5399 if (phs->sv == &PL_sv_undef) { /* first bind for this placeholder */
5400 phs->sql_type = (sql_type) ? sql_type : SQL_CHAR;
5401 phs->ftype = map_sql_types(phs->sql_type);
5402 if (imp_sth->type == 1) { /* RPC call, must set up the datafmt struct */
5403 if (phs->varname[0] == '@') {
5404 strcpy(phs->datafmt.name, phs->varname);
5405 phs->datafmt.namelen = strlen(phs->varname);
5406 } else
5407 phs->datafmt.namelen = 0;
5408 phs->datafmt.datatype = phs->ftype;
5409 phs->datafmt.status = phs->is_inout ? CS_RETURN : CS_INPUTVALUE;
5410 phs->datafmt.maxlength = 0;
5411 }
5412 phs->maxlen = maxlen; /* 0 if not inout */
5413 /* phs->is_inout = is_inout; */
5414 #if 0
5415 if (is_inout) {
5416 phs->sv = SvREFCNT_inc(newvalue); /* point to live var */
5417 ++imp_sth->has_inout_params;
5418 /* build array of phs's so we can deal with out vars fast */
5419 if (!imp_sth->out_params_av)
5420 imp_sth->out_params_av = newAV();
5421 av_push(imp_sth->out_params_av, SvREFCNT_inc(*phs_svp));
5422 }
5423 #endif
5424
5425 /* some types require the trailing null included in the length. */
5426 phs->alen_incnull = 0;
5427 }
5428 #if 0
5429 /* check later rebinds for any changes */
5430 else if (is_inout || phs->is_inout) {
5431 croak("Can't rebind or change param %s in/out mode after first bind", phs->name);
5432 }
5433 #endif
5434 else if (maxlen && maxlen != phs->maxlen) {
5435 croak("Can't change param %s maxlen (%ld->%ld) after first bind",
5436 phs->name, phs->maxlen, maxlen);
5437 }
5438
5439 if (!is_inout) { /* normal bind to take a (new) copy of current value */
5440 if (phs->sv == &PL_sv_undef) /* (first time bind) */
5441 phs->sv = newSV(0);
5442 sv_setsv(phs->sv, newvalue);
5443 phs->is_boundinout = 0;
5444 } else {
5445 phs->sv = SvREFCNT_inc(newvalue); /* Take a reference to the input variable */
5446 phs->is_boundinout = 1;
5447 if (DBIc_DBISTATE(imp_sth)->debug >= 3)
5448 PerlIO_printf(DBIc_LOGPIO(imp_sth), " parameter is bound as inout\n");
5449 }
5450
5451 /* BLK binding done at execute time, in a loop */
5452 if (imp_sth->type == 2)
5453 return 1;
5454
5455 return 1; /* _dbd_rebind_ph(sth, imp_sth, phs, 0); */
5456 }
5457
5458
fetch_data(imp_dbh_t * imp_dbh,CS_COMMAND * cmd)5459 static CS_RETCODE fetch_data(imp_dbh_t *imp_dbh, CS_COMMAND *cmd) {
5460 dTHX;
5461 CS_RETCODE retcode;
5462 CS_INT num_cols;
5463 CS_INT i;
5464 CS_INT j;
5465 CS_INT row_count = 0;
5466 CS_INT rows_read;
5467 CS_INT disp_len;
5468 CS_DATAFMT *datafmt;
5469 ColData *coldata;
5470
5471 char buff[1024];
5472
5473 /*
5474 ** Find out how many columns there are in this result set.
5475 */
5476 if ((retcode = ct_res_info(cmd, CS_NUMDATA, &num_cols, CS_UNUSED, NULL))
5477 != CS_SUCCEED) {
5478 warn("fetch_data: ct_res_info() failed");
5479 return retcode;
5480 }
5481
5482 /*
5483 ** Make sure we have at least one column
5484 */
5485 if (num_cols <= 0) {
5486 warn("fetch_data: ct_res_info() returned zero columns");
5487 return CS_FAIL;
5488 }
5489
5490 New(902, coldata, num_cols, ColData);
5491 New(902, datafmt, num_cols, CS_DATAFMT);
5492
5493 for (i = 0; i < num_cols; i++) {
5494 if ((retcode = ct_describe(cmd, (i + 1), &datafmt[i])) != CS_SUCCEED) {
5495 warn("fetch_data: ct_describe() failed");
5496 break;
5497 }
5498 datafmt[i].maxlength = display_dlen(&datafmt[i]) + 1;
5499 datafmt[i].datatype = CS_CHAR_TYPE;
5500 datafmt[i].format = CS_FMT_NULLTERM;
5501
5502 New(902, coldata[i].value.c, datafmt[i].maxlength, char);
5503 if ((retcode = ct_bind(cmd, (i + 1), &datafmt[i], coldata[i].value.c,
5504 &coldata[i].valuelen, &coldata[i].indicator)) != CS_SUCCEED) {
5505 warn("fetch_data: ct_bind() failed");
5506 break;
5507 }
5508 }
5509 if (retcode != CS_SUCCEED) {
5510 for (j = 0; j < i; j++) {
5511 Safefree(coldata[j].value.c);
5512 }
5513 Safefree(coldata);
5514 Safefree(datafmt);
5515 return retcode;
5516 }
5517
5518 display_header(imp_dbh, num_cols, datafmt);
5519
5520 while (((retcode = ct_fetch(cmd, CS_UNUSED, CS_UNUSED, CS_UNUSED,
5521 &rows_read)) == CS_SUCCEED) || (retcode == CS_ROW_FAIL)) {
5522 row_count = row_count + rows_read;
5523
5524 /*
5525 ** Check if we hit a recoverable error.
5526 */
5527 if (retcode == CS_ROW_FAIL) {
5528 sprintf(buff, "Error on row %ld.\n", row_count);
5529 sv_catpv(DBIc_ERRSTR(imp_dbh), buff);
5530 }
5531
5532 /*
5533 ** We have a row. Loop through the columns displaying the
5534 ** column values.
5535 */
5536 for (i = 0; i < num_cols; i++) {
5537 /*
5538 ** Display the column value
5539 */
5540 sv_catpv(DBIc_ERRSTR(imp_dbh), coldata[i].value.c);
5541
5542 /*
5543 ** If not last column, Print out spaces between this
5544 ** column and next one.
5545 */
5546 if (i != num_cols - 1) {
5547 disp_len = display_dlen(&datafmt[i]);
5548 disp_len -= coldata[i].valuelen - 1;
5549 for (j = 0; j < disp_len; j++) {
5550 sv_catpv(DBIc_ERRSTR(imp_dbh), " ");
5551 }
5552 }
5553 }
5554 sv_catpv(DBIc_ERRSTR(imp_dbh), "\n");
5555 }
5556
5557 /*
5558 ** Free allocated space.
5559 */
5560 for (i = 0; i < num_cols; i++) {
5561 Safefree(coldata[i].value.c);
5562 }
5563 Safefree(coldata);
5564 Safefree(datafmt);
5565
5566 /*
5567 ** We're done processing rows. Let's check the final return
5568 ** value of ct_fetch().
5569 */
5570 switch ((int) retcode) {
5571 case CS_END_DATA:
5572 retcode = CS_SUCCEED;
5573 break;
5574
5575 case CS_FAIL:
5576 warn("fetch_data: ct_fetch() failed");
5577 return retcode;
5578 break;
5579
5580 default: /* unexpected return value! */
5581 warn("fetch_data: ct_fetch() returned an expected retcode");
5582 return retcode;
5583 break;
5584 }
5585 return retcode;
5586 }
5587
map_sql_types(int sql_type)5588 static int map_sql_types(int sql_type) {
5589 int ret;
5590 switch (sql_type) {
5591 case SQL_NUMERIC:
5592 case SQL_DECIMAL:
5593 ret = CS_NUMERIC_TYPE;
5594 break;
5595 case SQL_BIT:
5596 case SQL_INTEGER:
5597 case SQL_SMALLINT:
5598 ret = CS_INT_TYPE;
5599 break;
5600 case SQL_FLOAT:
5601 case SQL_REAL:
5602 case SQL_DOUBLE:
5603 ret = CS_FLOAT_TYPE;
5604 break;
5605 case SQL_BINARY:
5606 return CS_BINARY_TYPE;
5607 break;
5608 default:
5609 ret = CS_CHAR_TYPE;
5610 }
5611
5612 return ret;
5613 }
5614
map_syb_types(int syb_type)5615 static int map_syb_types(int syb_type) {
5616 switch (syb_type) {
5617 case CS_CHAR_TYPE:
5618 return 1;
5619 case CS_BINARY_TYPE:
5620 return -2;
5621 /* case CS_LONGCHAR_TYPE: return SQL_CHAR; * XXX */
5622 /* case CS_LONGBINARY_TYPE: return SQL_BINARY; * XXX */
5623 case CS_TEXT_TYPE:
5624 return -1; /* XXX */
5625 case CS_IMAGE_TYPE:
5626 return -4; /* XXX */
5627 case CS_BIT_TYPE:
5628 return -7;
5629 case CS_TINYINT_TYPE:
5630 return -6;
5631 case CS_SMALLINT_TYPE:
5632 return 5;
5633 case CS_INT_TYPE:
5634 return 4;
5635 case CS_REAL_TYPE:
5636 return 7;
5637 case CS_FLOAT_TYPE:
5638 return 6;
5639 #if defined(CS_DATE_TYPE)
5640 case CS_DATE_TYPE:
5641 #endif
5642 case CS_DATETIME_TYPE:
5643 case CS_DATETIME4_TYPE:
5644 return 9;
5645 #if defined(CS_TIME_TYPE)
5646 case CS_TIME_TYPE:
5647 return 10;
5648 #endif
5649 case CS_MONEY_TYPE:
5650 case CS_MONEY4_TYPE:
5651 return 3;
5652 case CS_NUMERIC_TYPE:
5653 return 2;
5654 case CS_DECIMAL_TYPE:
5655 return 3;
5656 case CS_VARCHAR_TYPE:
5657 return 12;
5658 case CS_VARBINARY_TYPE:
5659 return -3;
5660 /* case CS_TIMESTAMP_TYPE: return -3; */
5661
5662 default:
5663 return SQL_CHAR;
5664 }
5665 }
5666
my_strdup(char * string)5667 static char *my_strdup(char *string) {
5668 char *buff = safemalloc(strlen(string) + 1);
5669 strcpy(buff, string);
5670
5671 return buff;
5672 }
5673
fetchKerbTicket(imp_dbh_t * imp_dbh)5674 static void fetchKerbTicket(imp_dbh_t *imp_dbh) {
5675 dTHX;
5676
5677 if (imp_dbh->kerbGetTicket) {
5678 dSP;
5679 SV *retval;
5680 int count;
5681 char *server = imp_dbh->server;
5682
5683 if (!*server) {
5684 char *s = getenv("DSQUERY");
5685 if (s && *s) {
5686 server = s;
5687 } else {
5688 server = "SYBASE";
5689 }
5690 }
5691
5692 ENTER;
5693 SAVETMPS;
5694 PUSHMARK(sp);
5695
5696 XPUSHs(sv_2mortal(newSVpv(server, 0)));
5697
5698 PUTBACK;
5699 if ((count = perl_call_sv(imp_dbh->kerbGetTicket, G_SCALAR)) != 1)
5700 croak("A Kerberos Ticket handler can't return a LIST.");
5701 SPAGAIN;
5702 retval = POPs;
5703
5704 PUTBACK;
5705 FREETMPS;
5706 LEAVE;
5707
5708 if (SvPOK(retval)) {
5709 strncpy(imp_dbh->kerberosPrincipal, SvPVX(retval), 255);
5710 imp_dbh->kerberosPrincipal[31] = 0;
5711 }
5712 }
5713 }
5714
5715 #if defined(NO_BLK)
syb_blk_init(imp_dbh_t * imp_dbh,imp_sth_t * imp_sth)5716 static CS_RETCODE syb_blk_init(imp_dbh_t *imp_dbh, imp_sth_t *imp_sth)
5717 {
5718 return CS_SUCCEED;
5719 }
5720 #else
syb_blk_init(imp_dbh_t * imp_dbh,imp_sth_t * imp_sth)5721 static CS_RETCODE syb_blk_init(imp_dbh_t *imp_dbh, imp_sth_t *imp_sth) {
5722 dTHX;
5723 CS_RETCODE ret;
5724 char table[256];
5725 int i, num_cols;
5726 SV **svp;
5727 phs_t *phs;
5728 char name[32];
5729
5730 if (!getTableName(imp_sth->statement, table, 256)) {
5731 char str[512];
5732 sprintf(str, "Can't get table name from '%.256s'", imp_sth->statement);
5733 syb_set_error(imp_dbh, -1, str);
5734 return CS_FAIL;
5735 }
5736 if (DBIc_DBISTATE(imp_dbh)->debug >= 4) {
5737 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
5738 " syb_blk_init(): table=%s\n", table);
5739 }
5740
5741 /* If AutoCommit is "officially" off here, then we need to make sure
5742 that Sybase thinks that it is *on*, otherwise the blk_init() call
5743 below will fail. */
5744
5745 if (!DBIc_is(imp_dbh, DBIcf_AutoCommit)) {
5746 toggle_autocommit(NULL, imp_dbh, 1);
5747 }
5748
5749 ret = blk_alloc(imp_sth->connection ? imp_sth->connection
5750 : imp_dbh->connection, BLK_VERSION, &imp_sth->bcp_desc);
5751 if (ret != CS_SUCCEED)
5752 goto FAIL;
5753 ret = blk_props(imp_sth->bcp_desc, CS_SET, BLK_IDENTITY,
5754 (CS_VOID*) &imp_sth->bcpIdentityFlag, CS_UNUSED, NULL);
5755 if (ret != CS_SUCCEED)
5756 goto FAIL;
5757
5758 ret = blk_init(imp_sth->bcp_desc, CS_BLK_IN, table, strlen(table));
5759 if (ret != CS_SUCCEED)
5760 goto FAIL;
5761
5762 num_cols = DBIc_NUM_PARAMS(imp_sth);
5763
5764 if (DBIc_DBISTATE(imp_dbh)->debug >= 4) {
5765 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
5766 " syb_blk_init(): num_cols=%d, identityFlag=%d\n",
5767 num_cols, imp_sth->bcpIdentityFlag);
5768 }
5769
5770 imp_sth->numCols = num_cols;
5771 /*Newz(902, imp_sth->datafmt, num_cols, CS_DATAFMT); */
5772 Newz(902, imp_sth->coldata, num_cols, ColData);
5773 for (i = 1; i <= num_cols; ++i) {
5774 sprintf(name, ":p%d", i);
5775 svp = hv_fetch(imp_sth->all_params_hv, name, strlen(name), 0);
5776 phs = ((phs_t*) (void*) SvPVX(*svp));
5777 memset(&phs->datafmt, 0, sizeof(CS_DATAFMT));
5778 ret = blk_describe(imp_sth->bcp_desc, i, &phs->datafmt);
5779
5780 if (DBIc_DBISTATE(imp_dbh)->debug >= 4)
5781 PerlIO_printf(
5782 DBIc_LOGPIO(imp_dbh),
5783 " syb_blk_init: blk_describe()==%d col %d, type %d, status %d, length %d\n",
5784 ret, i, phs->datafmt.datatype, phs->datafmt.status,
5785 phs->datafmt.maxlength);
5786
5787 if (ret != CS_SUCCEED)
5788 goto FAIL;
5789 }
5790
5791 FAIL: ;
5792 if (ret != CS_SUCCEED)
5793 blkCleanUp(imp_sth, imp_dbh);
5794 else {
5795 imp_dbh->imp_sth = imp_sth; /* hack! */
5796 /* Turn off autocommit for this handle, mainly to silence
5797 warnings from Sybase.xsi's commit() implementation */
5798 imp_sth->bcpAutoCommit = DBIc_is(imp_dbh, DBIcf_AutoCommit);
5799 DBIc_set(imp_dbh, DBIcf_AutoCommit, 0);
5800 }
5801
5802 return ret;
5803 }
5804 #endif
5805
5806 #if defined(NO_BLK)
blkCleanUp(imp_sth_t * imp_sth,imp_dbh_t * imp_dbh)5807 static void blkCleanUp(imp_sth_t *imp_sth, imp_dbh_t *imp_dbh)
5808 {
5809 ;
5810 }
5811 #else
blkCleanUp(imp_sth_t * imp_sth,imp_dbh_t * imp_dbh)5812 static void blkCleanUp(imp_sth_t *imp_sth, imp_dbh_t *imp_dbh) {
5813 int i;
5814
5815 for (i = 0; i < imp_sth->numCols; ++i)
5816 if (imp_sth->coldata[i].value.p && imp_sth->coldata[i].v_alloc)
5817 Safefree(imp_sth->coldata[i].value.p);
5818
5819 if (imp_sth->coldata)
5820 Safefree(imp_sth->coldata);
5821 imp_sth->numCols = 0;
5822 imp_sth->coldata = NULL;
5823 imp_sth->datafmt = NULL;
5824
5825 if (imp_sth->bcp_desc) {
5826 CS_INT ret = blk_drop(imp_sth->bcp_desc);
5827 if (DBIc_DBISTATE(imp_dbh)->debug >= 4)
5828 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
5829 " blkCleanUp -> blk_drop(%d) = %d\n", imp_sth->bcp_desc,
5830 ret);
5831 imp_sth->bcp_desc = NULL;
5832 }
5833 }
5834 #endif
5835
getTableName(char * statement,char * table,int maxwidth)5836 static int getTableName(char *statement, char *table, int maxwidth) {
5837 char *ptr = safemalloc(strlen(statement) + 1);
5838 char *p;
5839
5840 strcpy(ptr, statement);
5841 p = strtok(ptr, " ");
5842 if (!p || !*p || strncasecmp(p, "insert", 7))
5843 goto FAIL;
5844 p = strtok(NULL, " (");
5845 if (!p || !*p)
5846 goto FAIL;
5847 if (!strncasecmp(p, "into", 4))
5848 p = strtok(NULL, " (");
5849 if (!p || !*p)
5850 goto FAIL;
5851 strncpy(table, p, maxwidth);
5852 Safefree(ptr);
5853
5854 return 1;
5855
5856 FAIL: Safefree(ptr);
5857 return 0;
5858 }
5859
syb_set_cslib_cb(SV * cb)5860 SV *syb_set_cslib_cb(SV *cb) {
5861 #if 0
5862 /*!defined(USE_CSLIB_CB)*/
5863 warn("Can't set a CS-Lib callback: DBD::Sybase was not built with -DUSE_CSLIB_CB");
5864 return &PL_sv_undef;
5865 #else
5866 dTHX;
5867 SV *old = cslib_cb;
5868
5869 if (cslib_cb == (SV*) NULL)
5870 cslib_cb = newSVsv(cb);
5871 else
5872 sv_setsv(cslib_cb, cb);
5873
5874 return old ? old : &PL_sv_undef;
5875 #endif
5876 }
5877
5878 /* WARNING - dbh passed in here is in some cases NULL */
toggle_autocommit(SV * dbh,imp_dbh_t * imp_dbh,int flag)5879 static int toggle_autocommit(SV *dbh, imp_dbh_t *imp_dbh, int flag) {
5880 CS_BOOL value;
5881 CS_RETCODE ret;
5882 int current = DBIc_is(imp_dbh, DBIcf_AutoCommit);
5883
5884 if (!imp_dbh->init_done) {
5885 imp_dbh->init_done = 1;
5886 if (DBIc_DBISTATE(imp_dbh)->debug >= 5)
5887 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
5888 " toggle_autocommit: init_done not set, no action\n");
5889
5890 return TRUE;
5891 }
5892
5893 if (DBIc_DBISTATE(imp_dbh)->debug >= 5)
5894 PerlIO_printf(DBIc_LOGPIO(imp_dbh),
5895 " toggle_autocommit: current = %s, new = %s\n",
5896 current ? "on" : "off", flag ? "on" : "off");
5897 if (flag) {
5898 if (!current) {
5899 /* Going from OFF to ON - so force a COMMIT on any open
5900 transaction */
5901 syb_db_commit(dbh, imp_dbh);
5902 }
5903 if (!imp_dbh->doRealTran) {
5904 value = CS_FALSE;
5905 ret = syb_set_options(imp_dbh, CS_SET, CS_OPT_CHAINXACTS, &value,
5906 CS_UNUSED, NULL);
5907 }
5908 } else {
5909 if (!imp_dbh->doRealTran) {
5910 value = CS_TRUE;
5911 ret = syb_set_options(imp_dbh, CS_SET, CS_OPT_CHAINXACTS, &value,
5912 CS_UNUSED, NULL);
5913 }
5914 }
5915 if (!imp_dbh->doRealTran && ret != CS_SUCCEED) {
5916 warn("Setting of CS_OPT_CHAINXACTS failed.");
5917 return FALSE;
5918 }
5919
5920 return TRUE;
5921 }
5922