1 /*
2 * sqlrelayCmd.c
3 * Copyright (c) 2003 Takeshi Taguchi
4 * $Id: sqlrelayCmd.cpp,v 1.15 2016/03/13 19:39:54 mused Exp $
5 */
6
7 #include <tcl.h>
8 #include <sqlrelay/sqlrclient.h>
9 #include <rudiments/charstring.h>
10
11 #include <config.h>
12
13 #ifndef HAVE_TCL_GETSTRING
14 #define Tcl_GetString(a) Tcl_GetStringFromObj(a,NULL)
15 #endif
16
17 #ifdef HAVE_TCL_CONSTCHAR
18 #define CONSTCHAR const char
19 #else
20 #define CONSTCHAR char
21 #endif
22
23 #ifndef HAVE_TCL_WIDEINT
24 #define Tcl_WideInt long
25 #define Tcl_GetWideIntFromObj(a,b,c) Tcl_GetLongFromObj(a,b,c)
26 #endif
27
28 #ifdef HAVE_TCL_NEWSTRINGOBJ_CONST_CHAR
29 #define _Tcl_NewStringObj(a,b) Tcl_NewStringObj(a,b)
30 #else
31 #define _Tcl_NewStringObj(a,b) Tcl_NewStringObj((char *)(a),b)
32 #endif
33
34 extern "C" {
35
36 /*
37 * getCursorID --
38 * This procedure return tcl obj contains sqlrcur command name.
39 * Results:
40 * Tcl object.
41 * Side effects:
42 * count up static variable count.
43 */
getCursorID(void)44 Tcl_Obj *getCursorID(void) {
45 Tcl_Obj *id;
46 static int count = 0;
47
48 id = _Tcl_NewStringObj("sqlrcur", -1);
49 Tcl_AppendStringsToObj(id, Tcl_GetString(Tcl_NewIntObj(count++)),
50 (char *)NULL);
51 return (id);
52 }
53
54 /*
55 * sqlrcurDelete --
56 * This procedure is for deleting sqlrcur command.
57 * Results:
58 * none
59 * Side effects:
60 * call cur->free()
61 */
sqlrcurDelete(ClientData data)62 void sqlrcurDelete(ClientData data) {
63 sqlrcursor *cur = (sqlrcursor *)data;
64
65 if (cur != (sqlrcursor *)NULL) {
66 delete cur;
67 cur = (sqlrcursor *)NULL;
68 }
69 }
70
71 /*
72 * sqlrcurObjCmd --
73 * This procedure is invoked to process the "sqlrcur" object command.
74 * Synopsis:
75 * $cur eval query
76 * $cur setResultSetBufferSize ?rows?
77 * $cur getResultSetBufferSize
78 * $cur dontGetColumnInfo
79 * $cur getColumnInfo
80 * $cur caseColumnNames mixed|upper|low
81 * $cur cacheToFile filename
82 * $cur setCacheTtl ttl
83 * $cur getCacheFileName
84 * $cur cacheOff
85 * $cur getDatabaseList wild
86 * $cur getTableList wild
87 * $cur getColumnList table wild
88 * $cur sendQuery query
89 * $cur sendQueryWithLength query length
90 * $cur sendFileQuery path filename
91 * $cur prepareQuery query
92 * $cur prepareQueryWithLength query length
93 * $cur prepareFileQuery path filename
94 * $cur substitution variable value
95 * $cur clearBinds
96 * $cur countBindVariables
97 * $cur inputBind
98 * $cur inputBindBlob variable value size
99 * $cur inputBindClob variable value size
100 * $cur defineOutputBindString variable value
101 * $cur defineOutputBindInteger variable value
102 * $cur defineOutputBindDouble variable value
103 * $cur defineOutputBindBlob variable
104 * $cur defineOutputBindClob variable
105 * $cur defineOutputBindCursor variable
106 * $cur substitutions {{variable value} ...}
107 * $cur inputBinds {{variable value ?precision scale?} ...}
108 * $cur validateBinds
109 * $cur validBind
110 * $cur executeQuery
111 * $cur fetchFromBindCursor
112 * $cur getOutputBindString variable
113 * $cur getOutputBindBlob variable
114 * $cur getOutputBindClob variable
115 * $cur getOutputBindInteger variable
116 * $cur getOutputBindDouble variable
117 * $cur getOutputBindLength variable
118 * $cur getOutputBindCursor variable
119 * $cur openCachedResultSet variable
120 * $cur colCount
121 * $cur rowCount
122 * $cur totalRows
123 * $cur affectedRows
124 * $cur firstRowIndex
125 * $cur endOfResultSet
126 * $cur errorMessage
127 * $cur errorNumber
128 * $cur getFieldByIndex row col
129 * $cur getFieldByName row col
130 * $cur getFieldAsIntegerByIndex row col
131 * $cur getFieldAsIntegerByName row col
132 * $cur getFieldAsDoubleByIndex row col
133 * $cur getFieldAsDoubleByName row col
134 * $cur getFieldLengthByIndex row col
135 * $cur getFieldLengthByName row col
136 * $cur getRow row
137 * $cur getRowLengths row
138 * $cur getColumnNames
139 * $cur getColumnName col
140 * $cur getColumnTypeByIndex col
141 * $cur getColumnTypeByName col
142 * $cur getColumnLengthByIndex col
143 * $cur getColumnLengthByName col
144 * $cur getColumnPrecisionByIndex col
145 * $cur getColumnPrecisionByName col
146 * $cur getColumnScaleByIndex col
147 * $cur getColumnScaleByName col
148 * $cur getColumnIsNullableByIndex col
149 * $cur getColumnIsNullableByName col
150 * $cur getColumnIsPrimaryKeyByIndex col
151 * $cur getColumnIsPrimaryKeyByName col
152 * $cur getColumnIsUniqueByIndex col
153 * $cur getColumnIsUniqueByName col
154 * $cur getColumnIsPartOfKeyByIndex col
155 * $cur getColumnIsPartOfKeyByName col
156 * $cur getColumnIsUnsignedByIndex col
157 * $cur getColumnIsUnsignedByName col
158 * $cur getColumnIsZeroFilledByIndex col
159 * $cur getColumnIsZeroFilledByName col
160 * $cur getColumnIsBinaryByIndex col
161 * $cur getColumnIsBinaryByName col
162 * $cur getColumnIsAutoIncrementByIndex col
163 * $cur getColumnIsAutoIncrementByName col
164 * $cur getLongestByIndex col
165 * $cur getLongestByName col
166 * $cur getResultSetId
167 * $cur suspendResultSet
168 * $cur resumeResultSet is
169 * $cur resumeCachedResultSet id filename
170 * $cur closeResultSet
171 * Note:
172 * cur->getNullsAsEmptyStrings, and cur->getNullsAsNulls are not
173 * supported.
174 */
sqlrcurObjCmd(ClientData data,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])175 int sqlrcurObjCmd(ClientData data, Tcl_Interp *interp,
176 int objc, Tcl_Obj *CONST objv[]) {
177 sqlrcursor *cur = (sqlrcursor *)data;
178 int index;
179 static CONSTCHAR *options[] = {
180 "eval",
181 "setResultSetBufferSize",
182 "getResultSetBufferSize",
183 "dontGetColumnInfo",
184 "getColumnInfo",
185 "caseColumnNames",
186 "cacheToFile",
187 "setCacheTtl",
188 "getCacheFileName",
189 "cacheOff",
190 "getDatabaseList",
191 "getTableList",
192 "getColumnList",
193 "sendQuery",
194 "sendQueryWithLength",
195 "sendFileQuery",
196 "prepareQuery",
197 "prepareQueryWithLength",
198 "prepareFileQuery",
199 "substitution",
200 "clearBinds",
201 "countBindVariables",
202 "inputBind",
203 "inputBindBlob",
204 "inputBindClob",
205 "defineOutputBindString",
206 "defineOutputBindInteger",
207 "defineOutputBindDouble",
208 "defineOutputBindBlob",
209 "defineOutputBindClob",
210 "defineOutputBindCursor",
211 "substitutions",
212 "inputBinds",
213 "validateBinds",
214 "validBind",
215 "executeQuery",
216 "fetchFromBindCursor",
217 "getOutputBindString",
218 "getOutputBindBlob",
219 "getOutputBindClob",
220 "getOutputBindInteger",
221 "getOutputBindDouble",
222 "getOutputBindLength",
223 "getOutputBindCursor",
224 "openCachedResultSet",
225 "colCount",
226 "rowCount",
227 "totalRows",
228 "affectedRows",
229 "firstRowIndex",
230 "endOfResultSet",
231 "errorMessage",
232 "errorNumber",
233 "getFieldByIndex",
234 "getFieldByName",
235 "getFieldAsIntegerByIndex",
236 "getFieldAsIntegerByName",
237 "getFieldAsDoubleByIndex",
238 "getFieldAsDoubleByName",
239 "getFieldLengthByIndex",
240 "getFieldLengthByName",
241 "getRow",
242 "getRowLengths",
243 "getColumnNames",
244 "getColumnName",
245 "getColumnTypeByIndex",
246 "getColumnTypeByName",
247 "getColumnLengthByIndex",
248 "getColumnLengthByName",
249 "getColumnPrecisionByIndex",
250 "getColumnPrecisionByName",
251 "getColumnScaleByIndex",
252 "getColumnScaleByName",
253 "getColumnIsNullableByIndex",
254 "getColumnIsNullableByName",
255 "getColumnIsPrimaryKeyByIndex",
256 "getColumnIsPrimaryKeyByName",
257 "getColumnIsUniqueByIndex",
258 "getColumnIsUniqueByName",
259 "getColumnIsPartOfKeyByIndex",
260 "getColumnIsPartOfKeyByName",
261 "getColumnIsUnsignedByIndex",
262 "getColumnIsUnsignedByName",
263 "getColumnIsZeroFilledByIndex",
264 "getColumnIsZeroFilledByName",
265 "getColumnIsBinaryByIndex",
266 "getColumnIsBinaryByName",
267 "getColumnIsAutoIncrementByIndex",
268 "getColumnIsAutoIncrementByName",
269 "getLongestByIndex",
270 "getLongestByName",
271 "getResultSetId",
272 "suspendResultSet",
273 "resumeResultSet",
274 "resumeCachedResultSet",
275 "closeResultSet",
276 };
277
278 enum options {
279 SQLRCUR_eval,
280 SQLRCUR_setResultSetBufferSize,
281 SQLRCUR_getResultSetBufferSize,
282 SQLRCUR_dontGetColumnInfo,
283 SQLRCUR_getColumnInfo,
284 SQLRCUR_caseColumnNames,
285 SQLRCUR_cacheToFile,
286 SQLRCUR_setCacheTtl,
287 SQLRCUR_getCacheFileName,
288 SQLRCUR_cacheOff,
289 SQLRCUR_getDatabaseList,
290 SQLRCUR_getTableList,
291 SQLRCUR_getColumnList,
292 SQLRCUR_sendQuery,
293 SQLRCUR_sendQueryWithLength,
294 SQLRCUR_sendFileQuery,
295 SQLRCUR_prepareQuery,
296 SQLRCUR_prepareQueryWithLength,
297 SQLRCUR_prepareFileQuery,
298 SQLRCUR_substitution,
299 SQLRCUR_clearBinds,
300 SQLRCUR_countBindVariables,
301 SQLRCUR_inputBind,
302 SQLRCUR_inputBindBlob,
303 SQLRCUR_inputBindClob,
304 SQLRCUR_defineOutputBindString,
305 SQLRCUR_defineOutputBindInteger,
306 SQLRCUR_defineOutputBindDouble,
307 SQLRCUR_defineOutputBindBlob,
308 SQLRCUR_defineOutputBindClob,
309 SQLRCUR_defineOutputBindCursor,
310 SQLRCUR_substitutions,
311 SQLRCUR_inputBinds,
312 SQLRCUR_validateBinds,
313 SQLRCUR_validBind,
314 SQLRCUR_executeQuery,
315 SQLRCUR_fetchFromBindCursor,
316 SQLRCUR_getOutputBindString,
317 SQLRCUR_getOutputBindBlob,
318 SQLRCUR_getOutputBindClob,
319 SQLRCUR_getOutputBindInteger,
320 SQLRCUR_getOutputBindDouble,
321 SQLRCUR_getOutputBindLength,
322 SQLRCUR_getOutputBindCursor,
323 SQLRCUR_openCachedResultSet,
324 SQLRCUR_colCount,
325 SQLRCUR_rowCount,
326 SQLRCUR_totalRows,
327 SQLRCUR_affectedRows,
328 SQLRCUR_firstRowIndex,
329 SQLRCUR_endOfResultSet,
330 SQLRCUR_errorMessage,
331 SQLRCUR_errorNumber,
332 SQLRCUR_getFieldByIndex,
333 SQLRCUR_getFieldByName,
334 SQLRCUR_getFieldAsIntegerByIndex,
335 SQLRCUR_getFieldAsIntegerByName,
336 SQLRCUR_getFieldAsDoubleByIndex,
337 SQLRCUR_getFieldAsDoubleByName,
338 SQLRCUR_getFieldLengthByIndex,
339 SQLRCUR_getFieldLengthByName,
340 SQLRCUR_getRow,
341 SQLRCUR_getRowLengths,
342 SQLRCUR_getColumnNames,
343 SQLRCUR_getColumnName,
344 SQLRCUR_getColumnTypeByIndex,
345 SQLRCUR_getColumnTypeByName,
346 SQLRCUR_getColumnLengthByIndex,
347 SQLRCUR_getColumnLengthByName,
348 SQLRCUR_getColumnPrecisionByIndex,
349 SQLRCUR_getColumnPrecisionByName,
350 SQLRCUR_getColumnScaleByIndex,
351 SQLRCUR_getColumnScaleByName,
352 SQLRCUR_getColumnIsNullableByIndex,
353 SQLRCUR_getColumnIsNullableByName,
354 SQLRCUR_getColumnIsPrimaryKeyByIndex,
355 SQLRCUR_getColumnIsPrimaryKeyByName,
356 SQLRCUR_getColumnIsUniqueByIndex,
357 SQLRCUR_getColumnIsUniqueByName,
358 SQLRCUR_getColumnIsPartOfKeyByIndex,
359 SQLRCUR_getColumnIsPartOfKeyByName,
360 SQLRCUR_getColumnIsUnsignedByIndex,
361 SQLRCUR_getColumnIsUnsignedByName,
362 SQLRCUR_getColumnIsZeroFilledByIndex,
363 SQLRCUR_getColumnIsZeroFilledByName,
364 SQLRCUR_getColumnIsBinaryByIndex,
365 SQLRCUR_getColumnIsBinaryByName,
366 SQLRCUR_getColumnIsAutoIncrementByIndex,
367 SQLRCUR_getColumnIsAutoIncrementByName,
368 SQLRCUR_getLongestByIndex,
369 SQLRCUR_getLongestByName,
370 SQLRCUR_getResultSetId,
371 SQLRCUR_suspendResultSet,
372 SQLRCUR_resumeResultSet,
373 SQLRCUR_resumeCachedResultSet,
374 SQLRCUR_closeResultSet,
375 };
376
377 if (objc < 2) {
378 Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
379 return TCL_ERROR;
380 }
381
382 if (Tcl_GetIndexFromObj(interp, objv[1], (CONSTCHAR **)options, "option", 0,
383 (int *)&index) != TCL_OK) {
384 return TCL_ERROR;
385 }
386
387 switch ((enum options)index)
388 {
389 case SQLRCUR_eval:
390 {
391 uint64_t row;
392 uint32_t col;
393 Tcl_Obj *rowObj, *result;
394 if (objc != 3) {
395 Tcl_WrongNumArgs(interp, 2, objv, "query");
396 return TCL_ERROR;
397 }
398 if (!cur->sendQuery(Tcl_GetString(objv[2]))) {
399 Tcl_AppendResult(interp,cur->errorMessage(),(char *)NULL);
400 return TCL_ERROR;
401 }
402 result = Tcl_NewObj();
403 for (row = 0; row < cur->rowCount(); row++) {
404 rowObj = Tcl_NewObj();
405 for (col = 0; col < cur->colCount(); col++) {
406 const char *field = cur->getField(row, col);
407 uint32_t length = cur->getFieldLength(row, col);
408 if (field == (char *)NULL) { field = ""; }
409 if (Tcl_ListObjAppendElement(interp, rowObj,
410 _Tcl_NewStringObj(field, length))
411 != TCL_OK) {
412 return TCL_ERROR;
413 }
414 }
415 if (Tcl_ListObjAppendElement(interp, result, rowObj) != TCL_OK) {
416 return TCL_ERROR;
417 }
418 }
419 Tcl_SetObjResult(interp, result);
420 break;
421 }
422 case SQLRCUR_setResultSetBufferSize:
423 {
424 int rows = 0;
425 if (objc > 3) {
426 Tcl_WrongNumArgs(interp, 2, objv, "?rows?");
427 return TCL_ERROR;
428 } else if (objc == 3) {
429 if (Tcl_GetIntFromObj(interp, objv[2], &rows) != TCL_OK) {
430 return TCL_ERROR;
431 }
432 cur->setResultSetBufferSize(rows);
433 } else {
434 Tcl_SetObjResult(interp,
435 Tcl_NewIntObj(cur->getResultSetBufferSize()));
436 }
437 break;
438 }
439 case SQLRCUR_getResultSetBufferSize:
440 {
441 if (objc > 2) {
442 Tcl_WrongNumArgs(interp, 2, objv, NULL);
443 return TCL_ERROR;
444 }
445 Tcl_SetObjResult(interp,
446 Tcl_NewIntObj(cur->getResultSetBufferSize()));
447 break;
448 }
449 case SQLRCUR_dontGetColumnInfo:
450 {
451 if (objc > 2) {
452 Tcl_WrongNumArgs(interp, 2, objv, NULL);
453 return TCL_ERROR;
454 }
455 cur->dontGetColumnInfo();
456 break;
457 }
458 case SQLRCUR_getColumnInfo:
459 {
460 if (objc > 2) {
461 Tcl_WrongNumArgs(interp, 2, objv, NULL);
462 return TCL_ERROR;
463 }
464 cur->getColumnInfo();
465 break;
466 }
467 case SQLRCUR_caseColumnNames:
468 {
469 if (objc != 3) {
470 Tcl_WrongNumArgs(interp, 2, objv, "mixed|upper|lower");
471 return TCL_ERROR;
472 } else {
473 char *subopts = Tcl_GetString(objv[2]);
474 if (charstring::compareIgnoringCase(subopts, "mixed", 5) == 0) {
475 cur->mixedCaseColumnNames();
476 } else if (charstring::compareIgnoringCase(subopts, "upper", 5) == 0) {
477 cur->upperCaseColumnNames();
478 } else if (charstring::compareIgnoringCase(subopts, "lower", 5) == 0) {
479 cur->lowerCaseColumnNames();
480 } else {
481 Tcl_AppendResult(interp, "bad option \"", subopts, "\": must be mixed, upper, or lower", (char *)NULL);
482 return TCL_ERROR;
483 }
484 }
485 break;
486 }
487 case SQLRCUR_cacheToFile:
488 {
489 if (objc != 3) {
490 Tcl_WrongNumArgs(interp,2, objv, "filename");
491 return TCL_ERROR;
492 }
493 cur->cacheToFile(Tcl_GetString(objv[2]));
494 break;
495 }
496 case SQLRCUR_setCacheTtl:
497 {
498 int ttl = 0;
499 if (objc != 3) {
500 Tcl_WrongNumArgs(interp,2, objv, "ttl");
501 return TCL_ERROR;
502 }
503 if (Tcl_GetIntFromObj(interp, objv[2], &ttl) != TCL_OK) {
504 return TCL_ERROR;
505 }
506 cur->setCacheTtl(ttl);
507 break;
508 }
509 case SQLRCUR_getCacheFileName:
510 {
511 if (objc > 2) {
512 Tcl_WrongNumArgs(interp, 2, objv, NULL);
513 return TCL_ERROR;
514 }
515 Tcl_AppendResult(interp, cur->getCacheFileName(), (char *)NULL);
516 break;
517 }
518 case SQLRCUR_cacheOff:
519 {
520 if (objc > 2) {
521 Tcl_WrongNumArgs(interp, 2, objv, NULL);
522 return TCL_ERROR;
523 }
524 cur->cacheOff();
525 break;
526 }
527 case SQLRCUR_getDatabaseList:
528 {
529 int result = 0;
530 if (objc != 3) {
531 Tcl_WrongNumArgs(interp,2, objv, "wild");
532 return TCL_ERROR;
533 }
534 if (!(result = cur->getDatabaseList(Tcl_GetString(objv[2])))) {
535 Tcl_AppendResult(interp,cur->errorMessage(),(char *)NULL);
536 return TCL_ERROR;
537 }
538 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
539 break;
540 }
541 case SQLRCUR_getTableList:
542 {
543 int result = 0;
544 if (objc != 3) {
545 Tcl_WrongNumArgs(interp,2, objv, "wild");
546 return TCL_ERROR;
547 }
548 if (!(result = cur->getTableList(Tcl_GetString(objv[2])))) {
549 Tcl_AppendResult(interp,cur->errorMessage(),(char *)NULL);
550 return TCL_ERROR;
551 }
552 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
553 break;
554 }
555 case SQLRCUR_getColumnList:
556 {
557 int result = 0;
558 if (objc != 4) {
559 Tcl_WrongNumArgs(interp,3, objv, "table wild");
560 return TCL_ERROR;
561 }
562 if (!(result = cur->getColumnList(Tcl_GetString(objv[2]),Tcl_GetString(objv[3])))) {
563 Tcl_AppendResult(interp,cur->errorMessage(),(char *)NULL);
564 return TCL_ERROR;
565 }
566 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
567 break;
568 }
569 case SQLRCUR_sendQuery:
570 {
571 int result = 0;
572 if (objc != 3) {
573 Tcl_WrongNumArgs(interp,2, objv, "query");
574 return TCL_ERROR;
575 }
576 if (!(result = cur->sendQuery(Tcl_GetString(objv[2])))) {
577 Tcl_AppendResult(interp,cur->errorMessage(),(char *)NULL);
578 return TCL_ERROR;
579 }
580 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
581 break;
582 }
583 case SQLRCUR_sendQueryWithLength:
584 {
585 int result = 0;
586 int length = 0;
587 if (objc != 4) {
588 Tcl_WrongNumArgs(interp,3, objv, "query length");
589 return TCL_ERROR;
590 }
591 Tcl_GetIntFromObj(interp, objv[3], &length);
592 if (!(result = cur->sendQuery(Tcl_GetString(objv[2]),length))) {
593 Tcl_AppendResult(interp,cur->errorMessage(),(char *)NULL);
594 return TCL_ERROR;
595 }
596 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
597 break;
598 }
599 case SQLRCUR_sendFileQuery:
600 {
601 int result = 0;
602 if (objc != 4) {
603 Tcl_WrongNumArgs(interp,2, objv, "path filename");
604 return TCL_ERROR;
605 }
606 if (!(result = cur->sendFileQuery(Tcl_GetString(objv[2]),
607 Tcl_GetString(objv[3])))) {
608 Tcl_AppendResult(interp,cur->errorMessage(),(char *)NULL);
609 return TCL_ERROR;
610 }
611 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
612 break;
613 }
614 case SQLRCUR_prepareQuery:
615 {
616 if (objc != 3) {
617 Tcl_WrongNumArgs(interp,2, objv, "query");
618 return TCL_ERROR;
619 }
620 cur->prepareQuery(Tcl_GetString(objv[2]));
621 break;
622 }
623 case SQLRCUR_prepareQueryWithLength:
624 {
625 int length = 0;
626 if (objc != 4) {
627 Tcl_WrongNumArgs(interp,3, objv, "query length");
628 return TCL_ERROR;
629 }
630 Tcl_GetIntFromObj(interp, objv[3], &length);
631 cur->prepareQuery(Tcl_GetString(objv[2]),length);
632 break;
633 }
634 case SQLRCUR_prepareFileQuery:
635 {
636 if (objc != 4) {
637 Tcl_WrongNumArgs(interp,2, objv, "path filename");
638 return TCL_ERROR;
639 }
640 cur->prepareFileQuery(Tcl_GetString(objv[2]), Tcl_GetString(objv[3]));
641 break;
642 }
643 case SQLRCUR_substitution:
644 {
645 if (objc == 6) {
646 double value;
647 int precision, scale;
648 if (Tcl_GetDoubleFromObj(interp, objv[3], &value) != TCL_OK ||
649 Tcl_GetIntFromObj(interp, objv[4], &precision) != TCL_OK ||
650 Tcl_GetIntFromObj(interp, objv[5], &scale) != TCL_OK) {
651 return TCL_ERROR;
652 }
653 cur->substitution(Tcl_GetString(objv[2]), value, precision, scale);
654 } else if (objc == 4) {
655 long value;
656 if (Tcl_GetLongFromObj(interp, objv[3], &value) == TCL_OK ||
657 Tcl_GetIntFromObj(interp, objv[3], (int *)&value) == TCL_OK) {
658 cur->substitution(Tcl_GetString(objv[2]), value);
659 } else {
660 cur->substitution(Tcl_GetString(objv[2]), Tcl_GetString(objv[3]));
661 }
662 } else {
663 Tcl_WrongNumArgs(interp, 2, objv, "variable value ?precision scale?");
664 return TCL_ERROR;
665 }
666 break;
667 }
668 case SQLRCUR_clearBinds:
669 {
670 if (objc > 2) {
671 Tcl_WrongNumArgs(interp, 2, objv, NULL);
672 return TCL_ERROR;
673 }
674 cur->clearBinds();
675 break;
676 }
677 case SQLRCUR_countBindVariables:
678 {
679 long count;
680 if (objc > 2) {
681 Tcl_WrongNumArgs(interp, 2, objv, NULL);
682 return TCL_ERROR;
683 }
684 count=cur->countBindVariables();
685 Tcl_SetObjResult(interp, Tcl_NewLongObj(count));
686 break;
687 }
688 case SQLRCUR_inputBind:
689 {
690 if (objc == 6) {
691 double value;
692 int precision, scale;
693 if (Tcl_GetDoubleFromObj(interp, objv[3], &value) != TCL_OK ||
694 Tcl_GetIntFromObj(interp, objv[4], &precision) != TCL_OK ||
695 Tcl_GetIntFromObj(interp, objv[5], &scale) != TCL_OK) {
696 return TCL_ERROR;
697 }
698 cur->inputBind(Tcl_GetString(objv[2]),
699 value,
700 (uint32_t)precision,
701 (uint32_t)scale);
702 } else if (objc == 5) {
703 /* string with length */
704 long length;
705 if (Tcl_GetLongFromObj(interp, objv[3], &length) != TCL_OK) {
706 Tcl_GetIntFromObj(interp, objv[3], (int *)&length);
707 }
708 /* length must be > 0 */
709 if (length>0) {
710 cur->inputBind(Tcl_GetString(objv[2]),Tcl_GetString(objv[3]),
711 (uint32_t)length);
712 } else {
713 cur->inputBind(Tcl_GetString(objv[2]),Tcl_GetString(objv[3]));
714 }
715 } else if (objc == 4) {
716 long value;
717 if (Tcl_GetLongFromObj(interp, objv[3], &value) == TCL_OK ||
718 Tcl_GetIntFromObj(interp, objv[3], (int *)&value) == TCL_OK) {
719 /* value is long object */
720 cur->inputBind(Tcl_GetString(objv[2]), value);
721 } else {
722 /* value is not long object, so it might be string one */
723 cur->inputBind(Tcl_GetString(objv[2]), Tcl_GetString(objv[3]));
724 }
725 } else {
726 Tcl_WrongNumArgs(interp, 2, objv, "variable value ?precision scale?");
727 return TCL_ERROR;
728 }
729 break;
730 }
731 case SQLRCUR_inputBindBlob:
732 {
733 long size;
734 if (objc != 5) {
735 Tcl_WrongNumArgs(interp,2, objv, "variable value size");
736 return TCL_ERROR;
737 }
738 if (Tcl_GetLongFromObj(interp, objv[4], &size) != TCL_OK) {
739 return TCL_ERROR;
740 }
741 cur->inputBindBlob(Tcl_GetString(objv[2]),
742 Tcl_GetString(objv[3]),
743 (uint32_t)size);
744 break;
745 }
746 case SQLRCUR_inputBindClob:
747 {
748 long size;
749 if (objc != 5) {
750 Tcl_WrongNumArgs(interp,2, objv, "variable value size");
751 return TCL_ERROR;
752 }
753 if (Tcl_GetLongFromObj(interp, objv[4], &size) != TCL_OK) {
754 return TCL_ERROR;
755 }
756 cur->inputBindClob(Tcl_GetString(objv[2]),
757 Tcl_GetString(objv[3]),
758 (uint32_t)size);
759 break;
760 }
761 case SQLRCUR_defineOutputBindString:
762 {
763 long length;
764 if (objc != 4) {
765 Tcl_WrongNumArgs(interp,2, objv, "variable length");
766 return TCL_ERROR;
767 }
768 if (Tcl_GetLongFromObj(interp, objv[3], &length) != TCL_OK) {
769 return TCL_ERROR;
770 }
771 cur->defineOutputBindString(Tcl_GetString(objv[2]), length);
772 break;
773 }
774 case SQLRCUR_defineOutputBindInteger:
775 {
776 if (objc != 3) {
777 Tcl_WrongNumArgs(interp,1, objv, "variable");
778 return TCL_ERROR;
779 }
780 cur->defineOutputBindInteger(Tcl_GetString(objv[2]));
781 break;
782 }
783 case SQLRCUR_defineOutputBindDouble:
784 {
785 if (objc != 3) {
786 Tcl_WrongNumArgs(interp,1, objv, "variable");
787 return TCL_ERROR;
788 }
789 cur->defineOutputBindDouble(Tcl_GetString(objv[2]));
790 break;
791 }
792 case SQLRCUR_defineOutputBindBlob:
793 {
794 if (objc != 3) {
795 Tcl_WrongNumArgs(interp,2, objv, "variable");
796 return TCL_ERROR;
797 }
798 cur->defineOutputBindBlob(Tcl_GetString(objv[2]));
799 break;
800 }
801 case SQLRCUR_defineOutputBindClob:
802 {
803 if (objc != 3) {
804 Tcl_WrongNumArgs(interp,2, objv, "variable");
805 return TCL_ERROR;
806 }
807 cur->defineOutputBindClob(Tcl_GetString(objv[2]));
808 break;
809 }
810 case SQLRCUR_defineOutputBindCursor:
811 {
812 if (objc != 3) {
813 Tcl_WrongNumArgs(interp, 2, objv, "variable");
814 return TCL_ERROR;
815 }
816 cur->defineOutputBindCursor(Tcl_GetString(objv[2]));
817 break;
818 }
819 case SQLRCUR_substitutions:
820 {
821 int num = 0, len = 0, i = 0;
822 Tcl_Obj **argList, *variableObj, *valueObj, *precisionObj, *scaleObj;
823 if (objc != 3) {
824 Tcl_WrongNumArgs(interp, 2, objv, "{{variable value ?precision scale?}...}");
825 return TCL_ERROR;
826 }
827 if (Tcl_ListObjGetElements(interp, objv[2], &num, &argList) != TCL_OK) {
828 return TCL_ERROR;
829 }
830 for (i = 0; i < num; i++) {
831 if (Tcl_ListObjLength(interp, argList[i], &len) != TCL_OK) {
832 return TCL_ERROR;
833 } else if (len == 4) {
834 double value;
835 int precision, scale;
836 if (Tcl_ListObjIndex(interp, argList[i], 0,
837 &variableObj) != TCL_OK ||
838 Tcl_ListObjIndex(interp, argList[i], 1,
839 &valueObj) != TCL_OK ||
840 Tcl_ListObjIndex(interp, argList[i], 2,
841 &precisionObj) != TCL_OK ||
842 Tcl_ListObjIndex(interp, argList[i], 3,
843 &scaleObj) != TCL_OK ||
844 Tcl_GetDoubleFromObj(interp, valueObj,
845 &value) != TCL_OK ||
846 Tcl_GetIntFromObj(interp, precisionObj,
847 &precision) != TCL_OK ||
848 Tcl_GetIntFromObj(interp, scaleObj,
849 &scale) != TCL_OK) {
850 return TCL_ERROR;
851 }
852 cur->substitution(Tcl_GetString(variableObj),
853 value, precision, scale);
854 } else if (len == 2) {
855 long value;
856 if (Tcl_ListObjIndex(interp, argList[i], 0,
857 &variableObj) != TCL_OK ||
858 Tcl_ListObjIndex(interp, argList[i], 1,
859 &valueObj) != TCL_OK) {
860 return TCL_ERROR;
861 }
862 if ( Tcl_GetLongFromObj(interp, valueObj, &value) == TCL_OK ||
863 Tcl_GetIntFromObj(interp, valueObj, (int *)&value) == TCL_OK ) {
864 cur->substitution(Tcl_GetString(variableObj), value);
865 } else {
866 cur->substitution(Tcl_GetString(variableObj),
867 Tcl_GetString(valueObj));
868 }
869 } else {
870 Tcl_WrongNumArgs(interp, 2, objv, "{{variable value ?precision scale?} ...}");
871 return TCL_ERROR;
872 }
873 }
874 break;
875 }
876 case SQLRCUR_inputBinds:
877 {
878 int num = 0, len = 0, i = 0;
879 Tcl_Obj **argList, *variableObj, *valueObj, *precisionObj, *scaleObj;
880 if (objc != 3) {
881 Tcl_WrongNumArgs(interp, 2, objv, "{{variable value ?precision scale?}...}");
882 return TCL_ERROR;
883 }
884 if (Tcl_ListObjGetElements(interp, objv[2], &num, &argList) != TCL_OK) {
885 return TCL_ERROR;
886 }
887 for (i = 0; i < num; i++) {
888 if (Tcl_ListObjLength(interp, argList[i], &len) != TCL_OK) {
889 return TCL_ERROR;
890 } else if (len == 4) {
891 double value;
892 int precision, scale;
893 if (Tcl_ListObjIndex(interp, argList[i], 0,
894 &variableObj) != TCL_OK ||
895 Tcl_ListObjIndex(interp, argList[i], 1,
896 &valueObj) != TCL_OK ||
897 Tcl_ListObjIndex(interp, argList[i], 2,
898 &precisionObj) != TCL_OK ||
899 Tcl_ListObjIndex(interp, argList[i], 3,
900 &scaleObj) != TCL_OK ||
901 Tcl_GetDoubleFromObj(interp, valueObj,
902 &value) != TCL_OK ||
903 Tcl_GetIntFromObj(interp, precisionObj,
904 &precision) != TCL_OK ||
905 Tcl_GetIntFromObj(interp, scaleObj,
906 &scale) != TCL_OK) {
907 return TCL_ERROR;
908 }
909 cur->inputBind(Tcl_GetString(variableObj),
910 value, precision, scale);
911 } else if (len == 2) {
912 long value;
913 if (Tcl_ListObjIndex(interp, argList[i], 0,
914 &variableObj) != TCL_OK ||
915 Tcl_ListObjIndex(interp, argList[i], 1,
916 &valueObj) != TCL_OK) {
917 return TCL_ERROR;
918 }
919 if ( Tcl_GetLongFromObj(interp, valueObj, &value) == TCL_OK ||
920 Tcl_GetIntFromObj(interp, valueObj, (int *)&value) == TCL_OK ) {
921 cur->inputBind(Tcl_GetString(variableObj), value);
922 } else {
923 cur->inputBind(Tcl_GetString(variableObj),
924 Tcl_GetString(valueObj));
925 }
926 } else {
927 Tcl_WrongNumArgs(interp, 2, objv, "{{variable value ?precision scale?} ...}");
928 return TCL_ERROR;
929 }
930 }
931 break;
932 }
933 case SQLRCUR_validateBinds:
934 {
935 if (objc > 2) {
936 Tcl_WrongNumArgs(interp, 2, objv, NULL);
937 return TCL_ERROR;
938 }
939 cur->validateBinds();
940 break;
941 }
942 case SQLRCUR_validBind:
943 {
944 Tcl_Obj *result;
945 if (objc != 3) {
946 Tcl_WrongNumArgs(interp, 2, objv, "variable");
947 return TCL_ERROR;
948 }
949 result = Tcl_NewBooleanObj(cur->validBind(Tcl_GetString(objv[2])));
950 Tcl_SetObjResult(interp, result);
951 break;
952 }
953 case SQLRCUR_executeQuery:
954 {
955 int result = 0;
956 if (objc > 2) {
957 Tcl_WrongNumArgs(interp, 2, objv, NULL);
958 return TCL_ERROR;
959 }
960 if (!(result = cur->executeQuery())) {
961 Tcl_AppendResult(interp,cur->errorMessage(),(char *)NULL);
962 return TCL_ERROR;
963 }
964 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
965 break;
966 }
967 case SQLRCUR_fetchFromBindCursor:
968 {
969 int result = 0;
970 if (objc > 2) {
971 Tcl_WrongNumArgs(interp, 2, objv, NULL);
972 return TCL_ERROR;
973 }
974 if (!(result = cur->fetchFromBindCursor())) {
975 Tcl_AppendResult(interp,cur->errorMessage(),(char *)NULL);
976 return TCL_ERROR;
977 }
978 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
979 break;
980 }
981 case SQLRCUR_getOutputBindString:
982 {
983 Tcl_Obj *result;
984 if (objc != 3) {
985 Tcl_WrongNumArgs(interp, 2, objv, "variable");
986 return TCL_ERROR;
987 }
988 result = _Tcl_NewStringObj(cur->getOutputBindString(Tcl_GetString(objv[2])), cur->getOutputBindLength(Tcl_GetString(objv[2])));
989 Tcl_SetObjResult(interp, result);
990 break;
991 }
992 case SQLRCUR_getOutputBindBlob:
993 {
994 Tcl_Obj *result;
995 if (objc != 3) {
996 Tcl_WrongNumArgs(interp, 2, objv, "variable");
997 return TCL_ERROR;
998 }
999 result = _Tcl_NewStringObj(cur->getOutputBindBlob(Tcl_GetString(objv[2])), cur->getOutputBindLength(Tcl_GetString(objv[2])));
1000 Tcl_SetObjResult(interp, result);
1001 break;
1002 }
1003 case SQLRCUR_getOutputBindClob:
1004 {
1005 Tcl_Obj *result;
1006 if (objc != 3) {
1007 Tcl_WrongNumArgs(interp, 2, objv, "variable");
1008 return TCL_ERROR;
1009 }
1010 result = _Tcl_NewStringObj(cur->getOutputBindClob(Tcl_GetString(objv[2])), cur->getOutputBindLength(Tcl_GetString(objv[2])));
1011 Tcl_SetObjResult(interp, result);
1012 break;
1013 }
1014 case SQLRCUR_getOutputBindInteger:
1015 {
1016 Tcl_Obj *result;
1017 if (objc != 3) {
1018 Tcl_WrongNumArgs(interp, 2, objv, "variable");
1019 return TCL_ERROR;
1020 }
1021 result = Tcl_NewLongObj(cur->getOutputBindInteger(Tcl_GetString(objv[2])));
1022 Tcl_SetObjResult(interp, result);
1023 break;
1024 }
1025 case SQLRCUR_getOutputBindDouble:
1026 {
1027 Tcl_Obj *result;
1028 if (objc != 3) {
1029 Tcl_WrongNumArgs(interp, 2, objv, "variable");
1030 return TCL_ERROR;
1031 }
1032 result = Tcl_NewDoubleObj(cur->getOutputBindDouble(Tcl_GetString(objv[2])));
1033 Tcl_SetObjResult(interp, result);
1034 break;
1035 }
1036 case SQLRCUR_getOutputBindLength:
1037 {
1038 Tcl_Obj *result;
1039 if (objc != 3) {
1040 Tcl_WrongNumArgs(interp, 2, objv, "variable");
1041 return TCL_ERROR;
1042 }
1043 result = Tcl_NewLongObj(cur->getOutputBindLength(Tcl_GetString(objv[2])));
1044 Tcl_SetObjResult(interp, result);
1045 break;
1046 }
1047 case SQLRCUR_getOutputBindCursor:
1048 {
1049 Tcl_Obj *id;
1050 sqlrcursor *newcur = (sqlrcursor *)NULL;
1051 if (objc != 3) {
1052 Tcl_WrongNumArgs(interp, 2, objv, "variable");
1053 return TCL_ERROR;
1054 }
1055 newcur = cur->getOutputBindCursor(Tcl_GetString(objv[2]),true);
1056 if (newcur != (sqlrcursor *)NULL) {
1057 id = getCursorID();
1058 Tcl_CreateObjCommand(interp,
1059 Tcl_GetString(id),
1060 sqlrcurObjCmd,
1061 (ClientData)newcur,
1062 (Tcl_CmdDeleteProc *)sqlrcurDelete);
1063 Tcl_SetObjResult(interp, id);
1064 } else {
1065 return TCL_ERROR;
1066 }
1067 break;
1068 }
1069 case SQLRCUR_openCachedResultSet:
1070 {
1071 Tcl_Obj *result;
1072 if (objc != 3) {
1073 Tcl_WrongNumArgs(interp, 2, objv, "variable");
1074 return TCL_ERROR;
1075 }
1076 result = Tcl_NewBooleanObj(cur->openCachedResultSet(Tcl_GetString(objv[2])));
1077 Tcl_SetObjResult(interp, result);
1078 break;
1079 }
1080 case SQLRCUR_colCount:
1081 {
1082 Tcl_Obj *result;
1083 if (objc > 2) {
1084 Tcl_WrongNumArgs(interp, 2, objv, NULL);
1085 return TCL_ERROR;
1086 }
1087 result = Tcl_NewIntObj(cur->colCount());
1088 Tcl_SetObjResult(interp, result);
1089 break;
1090 }
1091 case SQLRCUR_rowCount:
1092 {
1093 Tcl_Obj *result;
1094 if (objc > 2) {
1095 Tcl_WrongNumArgs(interp, 2, objv, NULL);
1096 return TCL_ERROR;
1097 }
1098 result = Tcl_NewIntObj(cur->rowCount());
1099 Tcl_SetObjResult(interp, result);
1100 break;
1101 }
1102 case SQLRCUR_totalRows:
1103 {
1104 Tcl_Obj *result;
1105 if (objc > 2) {
1106 Tcl_WrongNumArgs(interp, 2, objv, NULL);
1107 return TCL_ERROR;
1108 }
1109 result = Tcl_NewIntObj(cur->totalRows());
1110 Tcl_SetObjResult(interp, result);
1111 break;
1112 }
1113 case SQLRCUR_affectedRows:
1114 {
1115 Tcl_Obj *result;
1116 if (objc > 2) {
1117 Tcl_WrongNumArgs(interp, 2, objv, NULL);
1118 return TCL_ERROR;
1119 }
1120 result = Tcl_NewIntObj(cur->affectedRows());
1121 Tcl_SetObjResult(interp, result);
1122 break;
1123 }
1124 case SQLRCUR_firstRowIndex:
1125 {
1126 Tcl_Obj *result;
1127 if (objc > 2) {
1128 Tcl_WrongNumArgs(interp, 2, objv, NULL);
1129 return TCL_ERROR;
1130 }
1131 result = Tcl_NewIntObj(cur->firstRowIndex());
1132 Tcl_SetObjResult(interp, result);
1133 break;
1134 }
1135 case SQLRCUR_endOfResultSet:
1136 {
1137 Tcl_Obj *result;
1138 if (objc > 2) {
1139 Tcl_WrongNumArgs(interp, 2, objv, NULL);
1140 return TCL_ERROR;
1141 }
1142 result = Tcl_NewBooleanObj(cur->endOfResultSet());
1143 Tcl_SetObjResult(interp, result);
1144 break;
1145 }
1146 case SQLRCUR_errorMessage:
1147 {
1148 const char *msg;
1149 if (objc > 2) {
1150 Tcl_WrongNumArgs(interp, 2, objv, NULL);
1151 return TCL_ERROR;
1152 }
1153 if ((msg = cur->errorMessage()) == NULL) {
1154 msg = "";
1155 }
1156 Tcl_SetObjResult(interp, _Tcl_NewStringObj(msg, -1));
1157 break;
1158 }
1159 case SQLRCUR_errorNumber:
1160 {
1161 if (objc > 2) {
1162 Tcl_WrongNumArgs(interp, 2, objv, NULL);
1163 return TCL_ERROR;
1164 }
1165 Tcl_SetObjResult(interp, Tcl_NewLongObj(cur->errorNumber()));
1166 break;
1167 }
1168 /*
1169 case SQLRCUR_getNullsAsEmptyStrings:
1170 case SQLRCUR_getNullsAsNulls:
1171 */
1172 case SQLRCUR_getFieldByIndex:
1173 {
1174 int row, col;
1175 const char *field = (const char *)NULL;
1176 if (objc != 4) {
1177 Tcl_WrongNumArgs(interp, 2, objv, "row col");
1178 return TCL_ERROR;
1179 }
1180 if (Tcl_GetIntFromObj(interp, objv[2], &row) != TCL_OK ||
1181 Tcl_GetIntFromObj(interp, objv[3], &col) != TCL_OK) {
1182 return TCL_ERROR;
1183 }
1184 if ((field = cur->getField(row, col)) == (const char *)NULL) {
1185 field = "";
1186 }
1187 Tcl_SetObjResult(interp, _Tcl_NewStringObj(field, cur->getFieldLength(row,col)));
1188 break;
1189 }
1190 case SQLRCUR_getFieldByName:
1191 {
1192 int row;
1193 const char *field = (const char *)NULL;
1194 if (objc != 4) {
1195 Tcl_WrongNumArgs(interp, 2, objv, "row col");
1196 return TCL_ERROR;
1197 }
1198 if (Tcl_GetIntFromObj(interp, objv[2], &row) != TCL_OK) {
1199 return TCL_ERROR;
1200 }
1201 if ((field = cur->getField(row, Tcl_GetString(objv[3]))) == (const char *)NULL) {
1202 field = "";
1203 }
1204 Tcl_SetObjResult(interp, _Tcl_NewStringObj(field, cur->getFieldLength(row, Tcl_GetString(objv[3]))));
1205 break;
1206 }
1207 case SQLRCUR_getFieldAsIntegerByIndex:
1208 {
1209 int row, col;
1210 if (objc != 4) {
1211 Tcl_WrongNumArgs(interp, 2, objv, "row col");
1212 return TCL_ERROR;
1213 }
1214 if (Tcl_GetIntFromObj(interp, objv[2], &row) != TCL_OK ||
1215 Tcl_GetIntFromObj(interp, objv[3], &col) != TCL_OK) {
1216 return TCL_ERROR;
1217 }
1218 Tcl_SetObjResult(interp, Tcl_NewLongObj(cur->getFieldAsInteger(row, col)));
1219 break;
1220 }
1221 case SQLRCUR_getFieldAsIntegerByName:
1222 {
1223 int row;
1224 if (objc != 4) {
1225 Tcl_WrongNumArgs(interp, 2, objv, "row col");
1226 return TCL_ERROR;
1227 }
1228 if (Tcl_GetIntFromObj(interp, objv[2], &row) != TCL_OK) {
1229 return TCL_ERROR;
1230 }
1231 Tcl_SetObjResult(interp, Tcl_NewLongObj(cur->getFieldAsInteger(row, Tcl_GetString(objv[3]))));
1232 break;
1233 }
1234 case SQLRCUR_getFieldAsDoubleByIndex:
1235 {
1236 int row, col;
1237 if (objc != 4) {
1238 Tcl_WrongNumArgs(interp, 2, objv, "row col");
1239 return TCL_ERROR;
1240 }
1241 if (Tcl_GetIntFromObj(interp, objv[2], &row) != TCL_OK ||
1242 Tcl_GetIntFromObj(interp, objv[3], &col) != TCL_OK) {
1243 return TCL_ERROR;
1244 }
1245 Tcl_SetObjResult(interp, Tcl_NewDoubleObj(cur->getFieldAsDouble(row, col)));
1246 break;
1247 }
1248 case SQLRCUR_getFieldAsDoubleByName:
1249 {
1250 int row;
1251 if (objc != 4) {
1252 Tcl_WrongNumArgs(interp, 2, objv, "row col");
1253 return TCL_ERROR;
1254 }
1255 if (Tcl_GetIntFromObj(interp, objv[2], &row) != TCL_OK) {
1256 return TCL_ERROR;
1257 }
1258 Tcl_SetObjResult(interp, Tcl_NewDoubleObj(cur->getFieldAsDouble(row, Tcl_GetString(objv[3]))));
1259 break;
1260 }
1261 case SQLRCUR_getFieldLengthByIndex:
1262 {
1263 int row, col;
1264 long length;
1265 if (objc != 4) {
1266 Tcl_WrongNumArgs(interp, 2, objv, "row col");
1267 return TCL_ERROR;
1268 }
1269 if (Tcl_GetIntFromObj(interp, objv[2], &row) != TCL_OK ||
1270 Tcl_GetIntFromObj(interp, objv[3], &col) != TCL_OK) {
1271 return TCL_ERROR;
1272 }
1273 length = cur->getFieldLength(row, col);
1274 Tcl_SetObjResult(interp, Tcl_NewLongObj(length));
1275 break;
1276 }
1277 case SQLRCUR_getFieldLengthByName:
1278 {
1279 int row;
1280 long length;
1281 if (objc != 4) {
1282 Tcl_WrongNumArgs(interp, 2, objv, "row col");
1283 return TCL_ERROR;
1284 }
1285 if (Tcl_GetIntFromObj(interp, objv[2], &row) != TCL_OK) {
1286 return TCL_ERROR;
1287 }
1288 length = cur->getFieldLength(row, Tcl_GetString(objv[3]));
1289 Tcl_SetObjResult(interp, Tcl_NewLongObj(length));
1290 break;
1291 }
1292 case SQLRCUR_getRow:
1293 {
1294 Tcl_WideInt row;
1295 uint32_t col;
1296 const char * const *rowarray;
1297 uint32_t *lengtharray;
1298 Tcl_Obj *resultList;
1299 if (objc != 3) {
1300 Tcl_WrongNumArgs(interp, 2, objv, "row");
1301 return TCL_ERROR;
1302 }
1303 if (Tcl_GetWideIntFromObj(interp, objv[2], &row) != TCL_OK) {
1304 return TCL_ERROR;
1305 }
1306 rowarray = cur->getRow(row);
1307 lengtharray = cur->getRowLengths(row);
1308 resultList = Tcl_NewObj();
1309 for (col = 0; col < cur->colCount(); col++) {
1310 if (Tcl_ListObjAppendElement(interp, resultList,
1311 _Tcl_NewStringObj((rowarray[col])?rowarray[col]:"", lengtharray[col])) != TCL_OK) {
1312 return TCL_ERROR;
1313 }
1314 }
1315 Tcl_SetObjResult(interp, resultList);
1316 break;
1317 }
1318 case SQLRCUR_getRowLengths:
1319 {
1320 Tcl_WideInt row;
1321 uint32_t col;
1322 uint32_t *lenarray;
1323 Tcl_Obj *resultList;
1324 if (objc != 3) {
1325 Tcl_WrongNumArgs(interp, 2, objv, "row");
1326 return TCL_ERROR;
1327 }
1328 if (Tcl_GetWideIntFromObj(interp, objv[2], &row) != TCL_OK) {
1329 return TCL_ERROR;
1330 }
1331 lenarray = cur->getRowLengths(row);
1332 resultList = Tcl_NewObj();
1333 for (col = 0; col < cur->colCount(); col++) {
1334 if (Tcl_ListObjAppendElement(interp, resultList,
1335 Tcl_NewLongObj(lenarray[col])) != TCL_OK) {
1336 return TCL_ERROR;
1337 }
1338 }
1339 Tcl_SetObjResult(interp, resultList);
1340 break;
1341 }
1342 case SQLRCUR_getColumnNames:
1343 {
1344 int i = 0;
1345 const char * const *namearray;
1346 Tcl_Obj *resultList;
1347 if (objc > 2) {
1348 Tcl_WrongNumArgs(interp, 2, objv, NULL);
1349 return TCL_ERROR;
1350 }
1351 namearray = cur->getColumnNames();
1352 resultList = Tcl_NewObj();
1353 while (namearray[i] != (const char *)NULL) {
1354 if (Tcl_ListObjAppendElement(interp, resultList,
1355 _Tcl_NewStringObj(namearray[i++], -1)) != TCL_OK) {
1356 return TCL_ERROR;
1357 }
1358 }
1359 Tcl_SetObjResult(interp,resultList);
1360 break;
1361 }
1362 case SQLRCUR_getColumnName:
1363 {
1364 int col;
1365 const char *name = (const char *)NULL;
1366 if (objc != 3) {
1367 Tcl_WrongNumArgs(interp, 2, objv, "col");
1368 return TCL_ERROR;
1369 }
1370 if (Tcl_GetIntFromObj(interp, objv[2], &col) != TCL_OK) {
1371 return TCL_ERROR;
1372 }
1373 if ((name = cur->getColumnName(col)) == (const char *)NULL) {
1374 name = "";
1375 }
1376 Tcl_SetObjResult(interp, _Tcl_NewStringObj(name, -1));
1377 break;
1378 }
1379 case SQLRCUR_getColumnTypeByIndex:
1380 {
1381 int col;
1382 const char *name = (const char *)NULL;
1383 if (objc != 3) {
1384 Tcl_WrongNumArgs(interp, 2, objv, "col");
1385 return TCL_ERROR;
1386 }
1387 if (Tcl_GetIntFromObj(interp, objv[2], &col) != TCL_OK) {
1388 return TCL_ERROR;
1389 }
1390 if ((name = cur->getColumnType(col)) == (const char *)NULL) {
1391 name = "";
1392 }
1393 Tcl_SetObjResult(interp, _Tcl_NewStringObj(name, -1));
1394 break;
1395 }
1396 case SQLRCUR_getColumnTypeByName:
1397 {
1398 const char *name = (const char *)NULL;
1399 if (objc != 3) {
1400 Tcl_WrongNumArgs(interp, 2, objv, "col");
1401 return TCL_ERROR;
1402 }
1403 if ((name = cur->getColumnType(Tcl_GetString(objv[2]))) == (const char *)NULL) {
1404 name = "";
1405 }
1406 Tcl_SetObjResult(interp, _Tcl_NewStringObj(name, -1));
1407 break;
1408 }
1409 case SQLRCUR_getColumnLengthByIndex:
1410 {
1411 int col;
1412 uint32_t len;
1413 if (objc != 3) {
1414 Tcl_WrongNumArgs(interp, 2, objv, "col");
1415 return TCL_ERROR;
1416 }
1417 if (Tcl_GetIntFromObj(interp, objv[2], &col) != TCL_OK) {
1418 return TCL_ERROR;
1419 }
1420 len = cur->getColumnLength(col);
1421 Tcl_SetObjResult(interp, Tcl_NewIntObj(len));
1422 break;
1423 }
1424 case SQLRCUR_getColumnLengthByName:
1425 {
1426 int len;
1427 if (objc != 3) {
1428 Tcl_WrongNumArgs(interp, 2, objv, "col");
1429 return TCL_ERROR;
1430 }
1431 len = cur->getColumnLength(Tcl_GetString(objv[2]));
1432 Tcl_SetObjResult(interp, Tcl_NewIntObj(len));
1433 break;
1434 }
1435 case SQLRCUR_getColumnPrecisionByIndex:
1436 {
1437 int col;
1438 uint32_t precision;
1439 if (objc != 3) {
1440 Tcl_WrongNumArgs(interp, 2, objv, "col");
1441 return TCL_ERROR;
1442 }
1443 if (Tcl_GetIntFromObj(interp, objv[2], &col) != TCL_OK) {
1444 return TCL_ERROR;
1445 }
1446 precision = cur->getColumnPrecision(col);
1447 Tcl_SetObjResult(interp, Tcl_NewLongObj(precision));
1448 break;
1449 }
1450 case SQLRCUR_getColumnPrecisionByName:
1451 {
1452 uint32_t precision;
1453 if (objc != 3) {
1454 Tcl_WrongNumArgs(interp, 2, objv, "col");
1455 return TCL_ERROR;
1456 }
1457 precision = cur->getColumnPrecision(Tcl_GetString(objv[2]));
1458 Tcl_SetObjResult(interp, Tcl_NewLongObj(precision));
1459 break;
1460 }
1461 case SQLRCUR_getColumnScaleByIndex:
1462 {
1463 int col;
1464 uint32_t scale;
1465 if (objc != 3) {
1466 Tcl_WrongNumArgs(interp, 2, objv, "col");
1467 return TCL_ERROR;
1468 }
1469 if (Tcl_GetIntFromObj(interp, objv[2], &col) != TCL_OK) {
1470 return TCL_ERROR;
1471 }
1472 scale = cur->getColumnScale(col);
1473 Tcl_SetObjResult(interp, Tcl_NewLongObj(scale));
1474 break;
1475 }
1476 case SQLRCUR_getColumnScaleByName:
1477 {
1478 uint32_t scale;
1479 if (objc != 3) {
1480 Tcl_WrongNumArgs(interp, 2, objv, "col");
1481 return TCL_ERROR;
1482 }
1483 scale = cur->getColumnScale(Tcl_GetString(objv[2]));
1484 Tcl_SetObjResult(interp, Tcl_NewLongObj(scale));
1485 break;
1486 }
1487 case SQLRCUR_getColumnIsNullableByIndex:
1488 {
1489 int col;
1490 bool isnullable;
1491 if (objc != 3) {
1492 Tcl_WrongNumArgs(interp, 2, objv, "col");
1493 return TCL_ERROR;
1494 }
1495 if (Tcl_GetIntFromObj(interp, objv[2], &col) != TCL_OK) {
1496 return TCL_ERROR;
1497 }
1498 isnullable = cur->getColumnIsNullable(col);
1499 Tcl_SetObjResult(interp, Tcl_NewLongObj(isnullable));
1500 break;
1501 }
1502 case SQLRCUR_getColumnIsNullableByName:
1503 {
1504 bool isnullable;
1505 if (objc != 3) {
1506 Tcl_WrongNumArgs(interp, 2, objv, "col");
1507 return TCL_ERROR;
1508 }
1509 isnullable = cur->getColumnIsNullable(Tcl_GetString(objv[2]));
1510 Tcl_SetObjResult(interp, Tcl_NewIntObj(isnullable));
1511 break;
1512 }
1513 case SQLRCUR_getColumnIsPrimaryKeyByIndex:
1514 {
1515 int col;
1516 bool isprimarykey;
1517 if (objc != 3) {
1518 Tcl_WrongNumArgs(interp, 2, objv, "col");
1519 return TCL_ERROR;
1520 }
1521 if (Tcl_GetIntFromObj(interp, objv[2], &col) != TCL_OK) {
1522 return TCL_ERROR;
1523 }
1524 isprimarykey = cur->getColumnIsPrimaryKey(col);
1525 Tcl_SetObjResult(interp, Tcl_NewLongObj(isprimarykey));
1526 break;
1527 }
1528 case SQLRCUR_getColumnIsPrimaryKeyByName:
1529 {
1530 bool isprimarykey;
1531 if (objc != 3) {
1532 Tcl_WrongNumArgs(interp, 2, objv, "col");
1533 return TCL_ERROR;
1534 }
1535 isprimarykey = cur->getColumnIsPrimaryKey(Tcl_GetString(objv[2]));
1536 Tcl_SetObjResult(interp, Tcl_NewIntObj(isprimarykey));
1537 break;
1538 }
1539 case SQLRCUR_getColumnIsUniqueByIndex:
1540 {
1541 int col;
1542 bool isunique;
1543 if (objc != 3) {
1544 Tcl_WrongNumArgs(interp, 2, objv, "col");
1545 return TCL_ERROR;
1546 }
1547 if (Tcl_GetIntFromObj(interp, objv[2], &col) != TCL_OK) {
1548 return TCL_ERROR;
1549 }
1550 isunique = cur->getColumnIsUnique(col);
1551 Tcl_SetObjResult(interp, Tcl_NewLongObj(isunique));
1552 break;
1553 }
1554 case SQLRCUR_getColumnIsUniqueByName:
1555 {
1556 bool isunique;
1557 if (objc != 3) {
1558 Tcl_WrongNumArgs(interp, 2, objv, "col");
1559 return TCL_ERROR;
1560 }
1561 isunique = cur->getColumnIsUnique(Tcl_GetString(objv[2]));
1562 Tcl_SetObjResult(interp, Tcl_NewIntObj(isunique));
1563 break;
1564 }
1565 case SQLRCUR_getColumnIsPartOfKeyByIndex:
1566 {
1567 int col;
1568 bool ispartofkey;
1569 if (objc != 3) {
1570 Tcl_WrongNumArgs(interp, 2, objv, "col");
1571 return TCL_ERROR;
1572 }
1573 if (Tcl_GetIntFromObj(interp, objv[2], &col) != TCL_OK) {
1574 return TCL_ERROR;
1575 }
1576 ispartofkey = cur->getColumnIsPartOfKey(col);
1577 Tcl_SetObjResult(interp, Tcl_NewLongObj(ispartofkey));
1578 break;
1579 }
1580 case SQLRCUR_getColumnIsPartOfKeyByName:
1581 {
1582 bool ispartofkey;
1583 if (objc != 3) {
1584 Tcl_WrongNumArgs(interp, 2, objv, "col");
1585 return TCL_ERROR;
1586 }
1587 ispartofkey = cur->getColumnIsPartOfKey(Tcl_GetString(objv[2]));
1588 Tcl_SetObjResult(interp, Tcl_NewIntObj(ispartofkey));
1589 break;
1590 }
1591 case SQLRCUR_getColumnIsUnsignedByIndex:
1592 {
1593 int col;
1594 bool isunsigned;
1595 if (objc != 3) {
1596 Tcl_WrongNumArgs(interp, 2, objv, "col");
1597 return TCL_ERROR;
1598 }
1599 if (Tcl_GetIntFromObj(interp, objv[2], &col) != TCL_OK) {
1600 return TCL_ERROR;
1601 }
1602 isunsigned = cur->getColumnIsUnsigned(col);
1603 Tcl_SetObjResult(interp, Tcl_NewLongObj(isunsigned));
1604 break;
1605 }
1606 case SQLRCUR_getColumnIsUnsignedByName:
1607 {
1608 bool isunsigned;
1609 if (objc != 3) {
1610 Tcl_WrongNumArgs(interp, 2, objv, "col");
1611 return TCL_ERROR;
1612 }
1613 isunsigned = cur->getColumnIsUnsigned(Tcl_GetString(objv[2]));
1614 Tcl_SetObjResult(interp, Tcl_NewIntObj(isunsigned));
1615 break;
1616 }
1617 case SQLRCUR_getColumnIsZeroFilledByIndex:
1618 {
1619 int col;
1620 bool iszerofilled;
1621 if (objc != 3) {
1622 Tcl_WrongNumArgs(interp, 2, objv, "col");
1623 return TCL_ERROR;
1624 }
1625 if (Tcl_GetIntFromObj(interp, objv[2], &col) != TCL_OK) {
1626 return TCL_ERROR;
1627 }
1628 iszerofilled = cur->getColumnIsZeroFilled(col);
1629 Tcl_SetObjResult(interp, Tcl_NewLongObj(iszerofilled));
1630 break;
1631 }
1632 case SQLRCUR_getColumnIsZeroFilledByName:
1633 {
1634 bool iszerofilled;
1635 if (objc != 3) {
1636 Tcl_WrongNumArgs(interp, 2, objv, "col");
1637 return TCL_ERROR;
1638 }
1639 iszerofilled = cur->getColumnIsZeroFilled(Tcl_GetString(objv[2]));
1640 Tcl_SetObjResult(interp, Tcl_NewIntObj(iszerofilled));
1641 break;
1642 }
1643 case SQLRCUR_getColumnIsBinaryByIndex:
1644 {
1645 int col;
1646 bool isbinary;
1647 if (objc != 3) {
1648 Tcl_WrongNumArgs(interp, 2, objv, "col");
1649 return TCL_ERROR;
1650 }
1651 if (Tcl_GetIntFromObj(interp, objv[2], &col) != TCL_OK) {
1652 return TCL_ERROR;
1653 }
1654 isbinary = cur->getColumnIsBinary(col);
1655 Tcl_SetObjResult(interp, Tcl_NewLongObj(isbinary));
1656 break;
1657 }
1658 case SQLRCUR_getColumnIsBinaryByName:
1659 {
1660 bool isbinary;
1661 if (objc != 3) {
1662 Tcl_WrongNumArgs(interp, 2, objv, "col");
1663 return TCL_ERROR;
1664 }
1665 isbinary = cur->getColumnIsBinary(Tcl_GetString(objv[2]));
1666 Tcl_SetObjResult(interp, Tcl_NewIntObj(isbinary));
1667 break;
1668 }
1669 case SQLRCUR_getColumnIsAutoIncrementByIndex:
1670 {
1671 int col;
1672 bool isautoinc;
1673 if (objc != 3) {
1674 Tcl_WrongNumArgs(interp, 2, objv, "col");
1675 return TCL_ERROR;
1676 }
1677 if (Tcl_GetIntFromObj(interp, objv[2], &col) != TCL_OK) {
1678 return TCL_ERROR;
1679 }
1680 isautoinc = cur->getColumnIsAutoIncrement(col);
1681 Tcl_SetObjResult(interp, Tcl_NewLongObj(isautoinc));
1682 break;
1683 }
1684 case SQLRCUR_getColumnIsAutoIncrementByName:
1685 {
1686 bool isautoinc;
1687 if (objc != 3) {
1688 Tcl_WrongNumArgs(interp, 2, objv, "col");
1689 return TCL_ERROR;
1690 }
1691 isautoinc = cur->getColumnIsAutoIncrement(Tcl_GetString(objv[2]));
1692 Tcl_SetObjResult(interp, Tcl_NewIntObj(isautoinc));
1693 break;
1694 }
1695 case SQLRCUR_getLongestByIndex:
1696 {
1697 int col;
1698 uint32_t len;
1699 if (objc != 3) {
1700 Tcl_WrongNumArgs(interp, 2, objv, "col");
1701 return TCL_ERROR;
1702 }
1703 if (Tcl_GetIntFromObj(interp, objv[2], &col) != TCL_OK) {
1704 return TCL_ERROR;
1705 }
1706 len = cur->getLongest(col);
1707 Tcl_SetObjResult(interp, Tcl_NewIntObj(len));
1708 break;
1709 }
1710 case SQLRCUR_getLongestByName:
1711 {
1712 int len;
1713 if (objc != 3) {
1714 Tcl_WrongNumArgs(interp, 2, objv, "col");
1715 return TCL_ERROR;
1716 }
1717 len = cur->getLongest(Tcl_GetString(objv[2]));
1718 Tcl_SetObjResult(interp, Tcl_NewIntObj(len));
1719 break;
1720 }
1721 case SQLRCUR_getResultSetId:
1722 {
1723 if (objc > 2) {
1724 Tcl_WrongNumArgs(interp, 2, objv, NULL);
1725 return TCL_ERROR;
1726 }
1727 Tcl_SetObjResult(interp, Tcl_NewIntObj(cur->getResultSetId()));
1728 break;
1729 }
1730 case SQLRCUR_suspendResultSet:
1731 {
1732 if (objc > 2) {
1733 Tcl_WrongNumArgs(interp, 2, objv, NULL);
1734 return TCL_ERROR;
1735 }
1736 cur->suspendResultSet();
1737 break;
1738 }
1739 case SQLRCUR_resumeResultSet:
1740 {
1741 int id;
1742 if (objc != 3) {
1743 Tcl_WrongNumArgs(interp, 2, objv, "id");
1744 return TCL_ERROR;
1745 }
1746 if (Tcl_GetIntFromObj(interp, objv[2], &id) != TCL_OK) {
1747 return TCL_ERROR;
1748 }
1749 Tcl_SetObjResult(interp,
1750 Tcl_NewBooleanObj(cur->resumeResultSet(id)));
1751 break;
1752 }
1753 case SQLRCUR_resumeCachedResultSet:
1754 {
1755 int id;
1756 if (objc != 4) {
1757 Tcl_WrongNumArgs(interp, 2, objv, "id filename");
1758 return TCL_ERROR;
1759 }
1760 if (Tcl_GetIntFromObj(interp, objv[2], &id) != TCL_OK) {
1761 return TCL_ERROR;
1762 }
1763 Tcl_SetObjResult(interp,
1764 Tcl_NewBooleanObj(cur->resumeCachedResultSet(id, Tcl_GetString(objv[3]))));
1765 break;
1766 }
1767 case SQLRCUR_closeResultSet:
1768 {
1769 if (objc > 2) {
1770 Tcl_WrongNumArgs(interp, 2, objv, NULL);
1771 return TCL_ERROR;
1772 }
1773 cur->closeResultSet();
1774 break;
1775 }
1776 }
1777 return TCL_OK;
1778 }
1779
1780 /*
1781 * sqlrcurCmd --
1782 * create new sqlrcur object command. This command itselfs is a
1783 * subcommand of sqlrcon object command. see below.
1784 */
sqlrcurCmd(ClientData data,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1785 int sqlrcurCmd(ClientData data, Tcl_Interp *interp,
1786 int objc, Tcl_Obj *CONST objv[]) {
1787 sqlrconnection *con = (sqlrconnection *)data;
1788 sqlrcursor *cur = (sqlrcursor *)NULL;
1789 Tcl_Obj *id;
1790
1791 if ((cur = new sqlrcursor(con,true)) == (sqlrcursor *)NULL) {
1792 Tcl_AppendResult(interp, "cannot allocate sqlrcursor", (char *)NULL);
1793 return TCL_ERROR;
1794 }
1795
1796 id = getCursorID();
1797 Tcl_CreateObjCommand(interp,
1798 Tcl_GetString(id),
1799 sqlrcurObjCmd,
1800 (ClientData)cur,
1801 (Tcl_CmdDeleteProc *)sqlrcurDelete);
1802 Tcl_SetObjResult(interp, id);
1803 return TCL_OK;
1804 }
1805
1806 /*
1807 * sqlrconDelete --
1808 */
sqlrconDelete(ClientData data)1809 void sqlrconDelete(ClientData data) {
1810 sqlrconnection *con = (sqlrconnection *)data;
1811 if (con != (sqlrconnection *)NULL) {
1812 delete con;
1813 con = (sqlrconnection *)NULL;
1814 }
1815 }
1816
1817 /*
1818 * sqlrconObjCmd --
1819 * sqlrcon object command.
1820 * Synopsis:
1821 * $con free
1822 * $con setConnectTimeout
1823 * $con setAuthenticationTimeout
1824 * $con setResponseTimeout
1825 * $con setBindVariableDelimiters
1826 * $con getBindVariableDelimiterQuestionMarkSupported
1827 * $con getBindVariableDelimiterColonSupported
1828 * $con getBindVariableDelimiterAtSignSupported
1829 * $con getBindVariableDelimiterDollarSignSupported
1830 * $con enableKerberos
1831 * $con enableTls
1832 * $con disableEncryption
1833 * $con endSession
1834 * $con suspendSession
1835 * $con getConnectionPort
1836 * $con getConnectionSocket
1837 * $con resumeSession port socket
1838 * $con ping
1839 * $con identify
1840 * $con dbVersion
1841 * $con dbHostName
1842 * $con dbIpAddress
1843 * $con serverVersion
1844 * $con clientVersion
1845 * $con bindFormat
1846 * $con selectDatabase db
1847 * $con getCurrentDatabase
1848 * $con getLastInsertId
1849 * $con autoCommit bool
1850 * $con begin
1851 * $con commit
1852 * $con rollback
1853 * $con errorMessage
1854 * $con debug ?bool?
1855 * $con setDebugFile debugfilename
1856 * $con setClientInfo clientinfo
1857 * $con getClientInfo
1858 * $con sqlrcur
1859 * set cur [$con sqlrcur]
1860 */
sqlrconObjCmd(ClientData data,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1861 int sqlrconObjCmd(ClientData data, Tcl_Interp *interp,
1862 int objc, Tcl_Obj *CONST objv[]) {
1863 sqlrconnection *con = (sqlrconnection *)data;
1864 int index;
1865 static CONSTCHAR *options[] = {
1866 "free",
1867 "setConnectTimeout",
1868 "setAuthenticationTimeout",
1869 "setResponseTimeout",
1870 "setBindVariableDelimiters",
1871 "getBindVariableDelimiterQuestionMarkSupported",
1872 "getBindVariableDelimiterColonSupported",
1873 "getBindVariableDelimiterAtSignSupported",
1874 "getBindVariableDelimiterDollarSignSupported",
1875 "enableKerberos",
1876 "enableTls",
1877 "disableEncryption",
1878 "endSession",
1879 "suspendSession",
1880 "getConnectionPort",
1881 "getConnectionSocket",
1882 "resumeSession",
1883 "ping",
1884 "identify",
1885 "dbVersion",
1886 "dbHostName",
1887 "dbIpAddress",
1888 "serverVersion",
1889 "clientVersion",
1890 "bindFormat",
1891 "selectDatabase",
1892 "getCurrentDatabase",
1893 "getLastInsertId",
1894 "autoCommit",
1895 "begin",
1896 "commit",
1897 "rollback",
1898 "errorMessage",
1899 "errorNumber",
1900 "debug",
1901 "setDebugFile",
1902 "setClientInfo",
1903 "getClientInfo",
1904 "sqlrcur",
1905 };
1906 enum options {
1907 SQLR_FREE,
1908 SQLR_SETCONNECTTIMEOUT,
1909 SQLR_SETAUTHENTICATIONTIMEOUT,
1910 SQLR_SETRESPONSETIMEOUT,
1911 SQLR_SETBINDVARIABLEDELIMITERS,
1912 SQLR_GETBINDVARIABLEDELIMITERQUESTIONMARKSUPPORTED,
1913 SQLR_GETBINDVARIABLEDELIMITERCOLONSUPPORTED,
1914 SQLR_GETBINDVARIABLEDELIMITERATSIGNSUPPORTED,
1915 SQLR_GETBINDVARIABLEDELIMITERDOLLARSIGNSUPPORTED,
1916 SQLR_ENABLEKERBEROS,
1917 SQLR_ENABLETLS,
1918 SQLR_DISABLEENCRYPTION,
1919 SQLR_ENDSESSION,
1920 SQLR_SUSPENDSESSION,
1921 SQLR_GETCONNECTIONPORT,
1922 SQLR_GETCONNECTIONSOCKET,
1923 SQLR_RESUMESESSION,
1924 SQLR_PING,
1925 SQLR_IDENTIFY,
1926 SQLR_DBVERSION,
1927 SQLR_DBHOSTNAME,
1928 SQLR_DBIPADDRESS,
1929 SQLR_SERVERVERSION,
1930 SQLR_CLIENTVERSION,
1931 SQLR_BINDFORMAT,
1932 SQLR_SELECTDATABASE,
1933 SQLR_GETCURRENTDATABASE,
1934 SQLR_GETLASTINSERTID,
1935 SQLR_AUTOCOMMIT,
1936 SQLR_BEGIN,
1937 SQLR_COMMIT,
1938 SQLR_ROLLBACK,
1939 SQLR_ERRORMESSAGE,
1940 SQLR_ERRORNUMBER,
1941 SQLR_DEBUG,
1942 SQLR_SETDEBUGFILE,
1943 SQLR_SETCLIENTINFO,
1944 SQLR_GETCLIENTINFO,
1945 SQLR_SQLRCUR,
1946 };
1947
1948 if (objc < 2) {
1949 Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
1950 return TCL_ERROR;
1951 }
1952
1953 if (Tcl_GetIndexFromObj(interp, objv[1], (CONSTCHAR **)options, "option", 0,
1954 (int *)&index) != TCL_OK) {
1955 return TCL_ERROR;
1956 }
1957
1958 switch ((enum options)index) {
1959 case SQLR_FREE: {
1960 if (objc > 2) {
1961 Tcl_WrongNumArgs(interp, 2, objv, NULL);
1962 return TCL_ERROR;
1963 }
1964 sqlrconDelete(con);
1965 break;
1966 }
1967 case SQLR_SETCONNECTTIMEOUT: {
1968 int timeoutsec;
1969 int timeoutusec;
1970 if (objc > 4) {
1971 Tcl_WrongNumArgs(interp, 2, objv, "timeoutsec timeoutusec");
1972 return TCL_ERROR;
1973 }
1974 if (Tcl_GetIntFromObj(interp, objv[2], &timeoutsec) != TCL_OK) {
1975 return TCL_ERROR;
1976 }
1977 if (Tcl_GetIntFromObj(interp, objv[3], &timeoutusec) != TCL_OK) {
1978 return TCL_ERROR;
1979 }
1980 con->setConnectTimeout(timeoutsec,timeoutusec);
1981 break;
1982 }
1983 case SQLR_SETAUTHENTICATIONTIMEOUT: {
1984 int timeoutsec;
1985 int timeoutusec;
1986 if (objc > 4) {
1987 Tcl_WrongNumArgs(interp, 2, objv, "timeoutsec timeoutusec");
1988 return TCL_ERROR;
1989 }
1990 if (Tcl_GetIntFromObj(interp, objv[2], &timeoutsec) != TCL_OK) {
1991 return TCL_ERROR;
1992 }
1993 if (Tcl_GetIntFromObj(interp, objv[3], &timeoutusec) != TCL_OK) {
1994 return TCL_ERROR;
1995 }
1996 con->setAuthenticationTimeout(timeoutsec,timeoutusec);
1997 break;
1998 }
1999 case SQLR_SETRESPONSETIMEOUT: {
2000 int timeoutsec;
2001 int timeoutusec;
2002 if (objc > 4) {
2003 Tcl_WrongNumArgs(interp, 2, objv, "timeoutsec timeoutusec");
2004 return TCL_ERROR;
2005 }
2006 if (Tcl_GetIntFromObj(interp, objv[2], &timeoutsec) != TCL_OK) {
2007 return TCL_ERROR;
2008 }
2009 if (Tcl_GetIntFromObj(interp, objv[3], &timeoutusec) != TCL_OK) {
2010 return TCL_ERROR;
2011 }
2012 con->setResponseTimeout(timeoutsec,timeoutusec);
2013 break;
2014 }
2015 case SQLR_SETBINDVARIABLEDELIMITERS: {
2016 const char *delimiter;
2017
2018 if (objc > 3) {
2019 Tcl_WrongNumArgs(interp, 1, objv, "delimiter");
2020 return TCL_ERROR;
2021 }
2022
2023 delimiter = Tcl_GetString(objv[2]);
2024
2025 con->setBindVariableDelimiters(delimiter);
2026 break;
2027 }
2028 case SQLR_GETBINDVARIABLEDELIMITERQUESTIONMARKSUPPORTED: {
2029 if (objc > 2) {
2030 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2031 return TCL_ERROR;
2032 }
2033 Tcl_SetObjResult(interp, Tcl_NewIntObj(
2034 con->getBindVariableDelimiterQuestionMarkSupported()));
2035 }
2036 case SQLR_GETBINDVARIABLEDELIMITERCOLONSUPPORTED: {
2037 if (objc > 2) {
2038 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2039 return TCL_ERROR;
2040 }
2041 Tcl_SetObjResult(interp, Tcl_NewIntObj(
2042 con->getBindVariableDelimiterColonSupported()));
2043 }
2044 case SQLR_GETBINDVARIABLEDELIMITERATSIGNSUPPORTED: {
2045 if (objc > 2) {
2046 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2047 return TCL_ERROR;
2048 }
2049 Tcl_SetObjResult(interp, Tcl_NewIntObj(
2050 con->getBindVariableDelimiterAtSignSupported()));
2051 }
2052 case SQLR_GETBINDVARIABLEDELIMITERDOLLARSIGNSUPPORTED: {
2053 if (objc > 2) {
2054 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2055 return TCL_ERROR;
2056 }
2057 Tcl_SetObjResult(interp, Tcl_NewIntObj(
2058 con->getBindVariableDelimiterDollarSignSupported()));
2059 }
2060 case SQLR_ENABLEKERBEROS: {
2061 const char *service;
2062 const char *mech;
2063 const char *flags;
2064
2065 if (objc > 5) {
2066 Tcl_WrongNumArgs(interp, 3, objv, "service mech flags");
2067 return TCL_ERROR;
2068 }
2069
2070 service = Tcl_GetString(objv[2]);
2071 mech = Tcl_GetString(objv[3]);
2072 flags = Tcl_GetString(objv[4]);
2073
2074 con->enableKerberos(service, mech, flags);
2075 break;
2076 }
2077 case SQLR_ENABLETLS: {
2078 const char *version;
2079 const char *cert;
2080 const char *password;
2081 const char *ciphers;
2082 const char *validate;
2083 const char *ca;
2084 int depth;
2085
2086 if (objc > 9) {
2087 Tcl_WrongNumArgs(interp, 7, objv, "version cert password ciphers validate ca depth");
2088 return TCL_ERROR;
2089 }
2090
2091 version = Tcl_GetString(objv[2]);
2092 cert = Tcl_GetString(objv[3]);
2093 password = Tcl_GetString(objv[4]);
2094 ciphers = Tcl_GetString(objv[5]);
2095 validate = Tcl_GetString(objv[6]);
2096 ca = Tcl_GetString(objv[7]);
2097 if (Tcl_GetIntFromObj(interp, objv[8], &depth) != TCL_OK) {
2098 return TCL_ERROR;
2099 }
2100
2101 con->enableTls(version, cert, password, ciphers, validate, ca, depth);
2102 break;
2103 }
2104 case SQLR_DISABLEENCRYPTION: {
2105 if (objc > 2) {
2106 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2107 return TCL_ERROR;
2108 }
2109 con->disableEncryption();
2110 break;
2111 }
2112 case SQLR_ENDSESSION: {
2113 if (objc > 2) {
2114 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2115 return TCL_ERROR;
2116 }
2117 con->endSession();
2118 break;
2119 }
2120 case SQLR_SUSPENDSESSION: {
2121 if (objc > 2) {
2122 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2123 return TCL_ERROR;
2124 }
2125 Tcl_SetObjResult(interp, Tcl_NewIntObj(con->suspendSession()));
2126 break;
2127 }
2128 case SQLR_GETCONNECTIONPORT: {
2129 if (objc > 2) {
2130 Tcl_WrongNumArgs(interp, 2, objv, "getConnectionPort");
2131 return TCL_ERROR;
2132 }
2133 Tcl_SetObjResult(interp, Tcl_NewIntObj(con->getConnectionPort()));
2134 break;
2135 }
2136 case SQLR_GETCONNECTIONSOCKET: {
2137 if (objc > 2) {
2138 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2139 return TCL_ERROR;
2140 }
2141 Tcl_SetObjResult(interp,
2142 _Tcl_NewStringObj(con->getConnectionSocket(),
2143 -1));
2144 break;
2145 }
2146 case SQLR_RESUMESESSION: {
2147 int port;
2148 const char *socket;
2149
2150 if (objc != 4) {
2151 Tcl_WrongNumArgs(interp, 2, objv, "port socket");
2152 return TCL_ERROR;
2153 }
2154 if (Tcl_GetIntFromObj(interp, objv[2], &port) != TCL_OK) {
2155 return TCL_ERROR;
2156 }
2157 socket = Tcl_GetString(objv[3]);
2158
2159 Tcl_SetObjResult(interp,
2160 Tcl_NewBooleanObj(con->resumeSession(port, socket)));
2161 break;
2162 }
2163 case SQLR_PING: {
2164 if (objc > 2) {
2165 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2166 return TCL_ERROR;
2167 }
2168 Tcl_SetObjResult(interp,
2169 Tcl_NewBooleanObj(con->ping()));
2170 break;
2171 }
2172 case SQLR_IDENTIFY: {
2173 if (objc > 2) {
2174 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2175 return TCL_ERROR;
2176 }
2177 Tcl_SetObjResult(interp,
2178 _Tcl_NewStringObj(con->identify(), -1));
2179 break;
2180 }
2181 case SQLR_DBVERSION: {
2182 if (objc > 2) {
2183 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2184 return TCL_ERROR;
2185 }
2186 Tcl_SetObjResult(interp,
2187 _Tcl_NewStringObj(con->dbVersion(), -1));
2188 break;
2189 }
2190 case SQLR_DBHOSTNAME: {
2191 if (objc > 2) {
2192 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2193 return TCL_ERROR;
2194 }
2195 Tcl_SetObjResult(interp,
2196 _Tcl_NewStringObj(con->dbHostName(), -1));
2197 break;
2198 }
2199 case SQLR_DBIPADDRESS: {
2200 if (objc > 2) {
2201 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2202 return TCL_ERROR;
2203 }
2204 Tcl_SetObjResult(interp,
2205 _Tcl_NewStringObj(con->dbIpAddress(), -1));
2206 break;
2207 }
2208 case SQLR_CLIENTVERSION: {
2209 if (objc > 2) {
2210 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2211 return TCL_ERROR;
2212 }
2213 Tcl_SetObjResult(interp,
2214 _Tcl_NewStringObj(con->clientVersion(), -1));
2215 break;
2216 }
2217 case SQLR_SERVERVERSION: {
2218 if (objc > 2) {
2219 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2220 return TCL_ERROR;
2221 }
2222 Tcl_SetObjResult(interp,
2223 _Tcl_NewStringObj(con->serverVersion(), -1));
2224 break;
2225 }
2226 case SQLR_BINDFORMAT: {
2227 if (objc > 2) {
2228 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2229 return TCL_ERROR;
2230 }
2231 Tcl_SetObjResult(interp,
2232 _Tcl_NewStringObj(con->bindFormat(), -1));
2233 break;
2234 }
2235 case SQLR_SELECTDATABASE: {
2236 if (objc != 3) {
2237 Tcl_WrongNumArgs(interp,2, objv, "db");
2238 return TCL_ERROR;
2239 }
2240 Tcl_SetObjResult(interp, Tcl_NewIntObj(con->selectDatabase(Tcl_GetString(objv[2]))));
2241 break;
2242 }
2243 case SQLR_GETCURRENTDATABASE: {
2244 if (objc > 2) {
2245 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2246 return TCL_ERROR;
2247 }
2248 Tcl_SetObjResult(interp,
2249 _Tcl_NewStringObj(con->getCurrentDatabase(), -1));
2250 break;
2251 }
2252 case SQLR_GETLASTINSERTID: {
2253 if (objc > 2) {
2254 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2255 return TCL_ERROR;
2256 }
2257 Tcl_SetObjResult(interp, Tcl_NewIntObj(con->getLastInsertId()));
2258 break;
2259 }
2260 case SQLR_AUTOCOMMIT: {
2261 int flag = 0;
2262 if (objc !=3) {
2263 Tcl_WrongNumArgs(interp, 2, objv, "bool");
2264 return TCL_ERROR;
2265 }
2266 if (Tcl_GetBooleanFromObj(interp, objv[2], &flag) != TCL_OK) {
2267 return TCL_ERROR;
2268 }
2269 if (flag) {
2270 Tcl_SetObjResult(interp, Tcl_NewIntObj(con->autoCommitOn()));
2271 } else {
2272 Tcl_SetObjResult(interp, Tcl_NewIntObj(con->autoCommitOff()));
2273 }
2274 break;
2275 }
2276 case SQLR_BEGIN: {
2277 if (objc > 2) {
2278 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2279 return TCL_ERROR;
2280 }
2281 Tcl_SetObjResult(interp, Tcl_NewIntObj(con->begin()));
2282 break;
2283 }
2284 case SQLR_COMMIT: {
2285 if (objc > 2) {
2286 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2287 return TCL_ERROR;
2288 }
2289 Tcl_SetObjResult(interp, Tcl_NewIntObj(con->commit()));
2290 break;
2291 }
2292 case SQLR_ROLLBACK:
2293 if (objc > 2) {
2294 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2295 return TCL_ERROR;
2296 }
2297 Tcl_SetObjResult(interp, Tcl_NewIntObj(con->rollback()));
2298 break;
2299 case SQLR_ERRORMESSAGE: {
2300 if (objc > 2) {
2301 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2302 return TCL_ERROR;
2303 }
2304 Tcl_SetObjResult(interp,_Tcl_NewStringObj(con->errorMessage(), -1));
2305 break;
2306 }
2307 case SQLR_ERRORNUMBER: {
2308 if (objc > 2) {
2309 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2310 return TCL_ERROR;
2311 }
2312 Tcl_SetObjResult(interp, Tcl_NewLongObj(con->errorNumber()));
2313 break;
2314 }
2315 case SQLR_DEBUG: {
2316 int flag = 0;
2317 if (objc == 2) {
2318 Tcl_SetObjResult(interp,
2319 Tcl_NewBooleanObj(con->getDebug()));
2320 break;
2321 } else if (objc == 3) {
2322 if (Tcl_GetBooleanFromObj(interp, objv[2], &flag) != TCL_OK) {
2323 return TCL_ERROR;
2324 }
2325 if (flag) {
2326 con->debugOn();
2327 } else {
2328 con->debugOff();
2329 }
2330 } else {
2331 Tcl_WrongNumArgs(interp, 2, objv, "debug ?bool?");
2332 return TCL_ERROR;
2333 }
2334 }
2335 case SQLR_SETDEBUGFILE: {
2336 if (objc != 3) {
2337 Tcl_WrongNumArgs(interp,2, objv, "debugfilename");
2338 return TCL_ERROR;
2339 }
2340 con->setDebugFile(Tcl_GetString(objv[2]));
2341 break;
2342 }
2343 case SQLR_SETCLIENTINFO: {
2344 if (objc != 3) {
2345 Tcl_WrongNumArgs(interp,2, objv, "clientinfo");
2346 return TCL_ERROR;
2347 }
2348 con->setClientInfo(Tcl_GetString(objv[2]));
2349 break;
2350 }
2351 case SQLR_GETCLIENTINFO: {
2352 if (objc > 2) {
2353 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2354 return TCL_ERROR;
2355 }
2356 Tcl_SetObjResult(interp,_Tcl_NewStringObj(con->getClientInfo(), -1));
2357 break;
2358 }
2359 case SQLR_SQLRCUR: {
2360 if (objc > 2) {
2361 Tcl_WrongNumArgs(interp, 2, objv, NULL);
2362 return TCL_ERROR;
2363 }
2364 if (sqlrcurCmd(data, interp, objc, objv) != TCL_OK) {
2365 return TCL_ERROR;
2366 }
2367 }
2368 }
2369 return TCL_OK;
2370 }
2371
2372 /*
2373 * sqlrconCmd --
2374 * the sqlrcon command itselfs.
2375 * Synopsis:
2376 * set con [sqlrcon -server server -port port -user user -password password ?-retrytime time -tries count?]
2377 * OR
2378 * set con [sqlrcon -socket socket -user user -password password ?-retrytime time -tries count?]
2379 */
sqlrconCmd(ClientData dummy,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2380 int sqlrconCmd(ClientData dummy, Tcl_Interp *interp,
2381 int objc, Tcl_Obj *CONST objv[]) {
2382 static int count = 0;
2383 static CONSTCHAR *optionStrings[] = {
2384 "-server",
2385 "-port",
2386 "-socket",
2387 "-user",
2388 "-password",
2389 "-retrytime",
2390 "-tries",
2391 (char *)NULL
2392 };
2393 enum options {
2394 SQLRCON_SERVER,
2395 SQLRCON_PORT,
2396 SQLRCON_SOCKET,
2397 SQLRCON_USER,
2398 SQLRCON_PASSWORD,
2399 SQLRCON_RETRYTIME,
2400 SQLRCON_TRIES,
2401 };
2402 int i;
2403 CONSTCHAR *server, *socket, *user, *password;
2404 int port = 9000, retrytime = 0, tries = 1;
2405 sqlrconnection *con = (sqlrconnection *)NULL;
2406 Tcl_Obj *id;
2407
2408 if (objc < 2) {
2409 Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
2410 return TCL_ERROR;
2411 }
2412
2413 server = socket = user = password = "";
2414 for (i = 1; objc > i; i += 2) {
2415 int index;
2416
2417 if (Tcl_GetIndexFromObj(interp, objv[i],
2418 (CONSTCHAR **)optionStrings,
2419 "option",
2420 0,
2421 (int *)&index) != TCL_OK) {
2422 return TCL_ERROR;
2423 }
2424
2425 switch ((enum options)index) {
2426 case SQLRCON_SERVER: {
2427 server = Tcl_GetString(objv[i+1]);
2428 break;
2429 }
2430 case SQLRCON_PORT: {
2431 if (Tcl_GetIntFromObj(interp, objv[i+1], &port) != TCL_OK) {
2432 return TCL_ERROR;
2433 }
2434 break;
2435 }
2436 case SQLRCON_SOCKET:
2437 socket = Tcl_GetString(objv[i+1]);
2438 break;
2439 case SQLRCON_USER: {
2440 user = Tcl_GetString(objv[i+1]);
2441 break;
2442 }
2443 case SQLRCON_PASSWORD: {
2444 password = Tcl_GetString(objv[i+1]);
2445 break;
2446 }
2447 case SQLRCON_RETRYTIME: {
2448 if (Tcl_GetIntFromObj(interp, objv[i+1], &retrytime) != TCL_OK) {
2449 return TCL_ERROR;
2450 }
2451 break;
2452 }
2453 case SQLRCON_TRIES:
2454 if (Tcl_GetIntFromObj(interp, objv[i+1], &tries) != TCL_OK) {
2455 return TCL_ERROR;
2456 }
2457 break;
2458 }
2459 }
2460
2461 if (charstring::compare("",server,1) == 0 && charstring::compare("", socket, 1) == 0) {
2462 Tcl_AppendResult(interp,
2463 "-server name or -socket name required", (char *)NULL);
2464 return TCL_ERROR;
2465 }
2466
2467 con = new sqlrconnection(server, port, socket, user, password,
2468 retrytime, tries,true);
2469
2470
2471 id = _Tcl_NewStringObj("sqlrcon", -1);
2472 Tcl_AppendStringsToObj(id, Tcl_GetString(Tcl_NewIntObj(count++)),
2473 (char *)NULL);
2474
2475 Tcl_CreateObjCommand(interp, Tcl_GetString(id), sqlrconObjCmd,
2476 (ClientData)con,
2477 (Tcl_CmdDeleteProc *)sqlrconDelete);
2478
2479 Tcl_SetObjResult(interp, id);
2480 return TCL_OK;
2481 }
2482
Sqlrelay_Init(Tcl_Interp * interp)2483 DLLEXPORT int Sqlrelay_Init(Tcl_Interp *interp) {
2484 #ifdef USE_TCL_STUBS
2485 Tcl_InitStubs(interp, "8.2", 0);
2486 #endif
2487 Tcl_CreateObjCommand(interp, "sqlrcon", sqlrconCmd,
2488 (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
2489 return Tcl_PkgProvide(interp, "sqlrelay", "1.0");
2490 }
2491
2492 }
2493