1 /*
2 * Interface between MongoDB based on NSF (Next Scripting
3 * Framework)
4 *
5 * This implementation provides a low-level interface based on tagged elements
6 * to force / preserve the datatypes of MongoDB when converting into Tcl.
7 *
8 * This code serves as well as an example how to use the source code generator
9 * of NSF. The example shows how to use the source code generator from NSF to
10 * generate a C interface.
11 *
12 * -gustaf neumann March 27, 2011
13 *
14 * Copyright (C) 2011-2018 Gustaf Neumann
15 */
16 #include <stdlib.h>
17 #include <stdio.h>
18 #include <string.h>
19 #include "bson.h"
20 #include "mongoc.h"
21
22 #include <tcl.h>
23 #include <assert.h>
24 #include <nsf.h>
25
26 #define USE_CLIENT_POOL 1
27
28 /*
29 * Define the counters to generate nice symbols for pointer converter
30 */
31 static int gridfileCount = 0;
32 static int gridfsCount = 0;
33 static int mongoClientCount = 0;
34 static int mongoCollectionCount = 0;
35 static int mongoCursorCount = 0;
36
37 #if defined(USE_CLIENT_POOL)
38 static NsfMutex poolMutex = 0;
39 static mongoc_client_pool_t *mongoClientPool = NULL;
40 static int mongoClientPoolRefCount = 0;
41 static mongoc_uri_t *mongoUri = NULL;
42 #endif
43
44 typedef enum {
45 NSF_BSON_ARRAY,
46 NSF_BSON_BINARY,
47 NSF_BSON_BOOL,
48 NSF_BSON_INT32,
49 NSF_BSON_INT64,
50 NSF_BSON_DATE_TIME,
51 NSF_BSON_DECIMAL128,
52 NSF_BSON_DOCUMENT,
53 NSF_BSON_DOUBLE,
54 NSF_BSON_MINKEY,
55 NSF_BSON_MAXKEY,
56 NSF_BSON_NULL,
57 NSF_BSON_OID,
58 NSF_BSON_REGEX,
59 NSF_BSON_STRING,
60 NSF_BSON_TIMESTAMP,
61 NSF_BSON_UNKNOWN
62 } nsfMongoTypes;
63
64 static const char *
65 NsfMongoGlobalStrings[] = {
66 "array",
67 "binary",
68 "boolean",
69 "int32",
70 "int64",
71 "datetime",
72 "decimal128",
73 "document",
74 "double",
75 "minkey",
76 "maxkey",
77 "null",
78 "oid",
79 "regex",
80 "string",
81 "timestamp",
82 "unknown",
83 NULL
84 };
85 static Tcl_Obj **NsfMongoGlobalObjs = NULL;
86
87 static Tcl_Obj *BsonToList(Tcl_Interp *interp, const bson_t *data , int depth);
88 static bson_type_t BsonTagToType(Tcl_Interp *interp, const char *tag);
89
90 extern Tcl_PackageInitProc Nsfmongo_SafeInit;
91 extern Tcl_PackageInitProc Nsfmongo_Init;
92 static Tcl_ExitProc Nsfmongo_Exit;
93 static Tcl_ExitProc Nsfmongo_ThreadExit;
94
95 Nsf_TypeConverter Nsf_ConvertTo_Boolean;
96 Nsf_TypeConverter Nsf_ConvertTo_Class;
97 Nsf_TypeConverter Nsf_ConvertTo_Int32;
98 Nsf_TypeConverter Nsf_ConvertTo_Integer;
99 Nsf_TypeConverter Nsf_ConvertTo_Object;
100 Nsf_TypeConverter Nsf_ConvertTo_Pointer;
101 Nsf_TypeConverter Nsf_ConvertTo_String;
102 Nsf_TypeConverter Nsf_ConvertTo_Tclobj;
103
104 /***********************************************************************
105 * The following definitions should not be here, but they are included
106 * to get compilation going for the time being.
107 ***********************************************************************/
108 typedef void *NsfObject;
109
110 #define PARSE_CONTEXT_PREALLOC 20
111 typedef struct {
112 ClientData *clientData; /* 4 members pointer to the actual parse context data */
113 Tcl_Obj **objv;
114 Tcl_Obj **full_objv; /* contains method as well */
115 unsigned int *flags;
116 ClientData clientData_static[PARSE_CONTEXT_PREALLOC]; /* 3 members preallocated parse context data */
117 Tcl_Obj *objv_static[PARSE_CONTEXT_PREALLOC+1];
118 unsigned int flags_static[PARSE_CONTEXT_PREALLOC+1];
119 unsigned int status;
120 int lastObjc; /* points to the first "unprocessed" argument */
121 int objc;
122 NsfObject *object;
123 int varArgs; /* does the parameter end with some kind of "args" */
124 } ParseContext;
125
126 #define nr_elements(arr) ((int) (sizeof(arr) / sizeof(arr[0])))
127 #define ObjStr(obj) (obj)->bytes ? (obj)->bytes : Tcl_GetString(obj)
128 #ifdef UNUSED
129 #elif defined(__GNUC__)
130 # define UNUSED(x) UNUSED_ ## x __attribute__((unused))
131 #elif defined(__LCLINT__)
132 # define UNUSED(x) /*@unused@*/ x
133 #else
134 # define UNUSED(x) x
135 #endif
136
137
138 #if defined(HAVE_STDINT_H)
139 # define HAVE_INTPTR_T
140 # define HAVE_UINTPTR_T
141 #endif
142
143 #if !defined(INT2PTR) && !defined(PTR2INT)
144 # if defined(HAVE_INTPTR_T) || defined(intptr_t)
145 # define INT2PTR(p) ((void *)(intptr_t)(p))
146 # define PTR2INT(p) ((int)(intptr_t)(p))
147 # else
148 # define INT2PTR(p) ((void *)(p))
149 # define PTR2INT(p) ((int)(p))
150 # endif
151 #endif
152 #if !defined(UINT2PTR) && !defined(PTR2UINT)
153 # if defined(HAVE_UINTPTR_T) || defined(uintptr_t)
154 # define UINT2PTR(p) ((void *)(uintptr_t)(p))
155 # define PTR2UINT(p) ((unsigned int)(uintptr_t)(p))
156 # else
157 # define UINT2PTR(p) ((void *)(p))
158 # define PTR2UINT(p) ((unsigned int)(p))
159 # endif
160 #endif
161
162
ArgumentParse(Tcl_Interp * interp,int objc,Tcl_Obj * const objv[],NsfObject * obj,Tcl_Obj * procName,Nsf_Param const * paramPtr,int nrParameters,int serial,unsigned int processFlags,ParseContext * pc)163 static int ArgumentParse(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
164 NsfObject *obj, Tcl_Obj *procName,
165 Nsf_Param const *paramPtr, int nrParameters, int serial,
166 unsigned int processFlags, ParseContext *pc) {
167 return Nsf_ArgumentParse(interp, objc, objv, (Nsf_Object *)obj,
168 procName, paramPtr, nrParameters, serial,
169 processFlags, (Nsf_ParseContext *)pc);
170 }
171
172 /***********************************************************************
173 * Include the generated mongo db API.
174 ***********************************************************************/
175
176 #include "mongoAPI.h"
177
178 /***********************************************************************
179 * Helper functions
180 ***********************************************************************/
181
182 /*
183 *----------------------------------------------------------------------
184 *
185 * BsonToList --
186 *
187 * Convert a bson_t structure to a tagged list. Each value field is
188 * preceded by a tag denoting its bson type.
189 *
190 * Results:
191 * Tagged list.
192 *
193 * Side effects:
194 * None.
195 *
196 *----------------------------------------------------------------------
197 */
198 Tcl_Obj *
BsonToList(Tcl_Interp * interp,const bson_t * data,int depth)199 BsonToList(Tcl_Interp *interp, const bson_t *data , int depth)
200 {
201 bson_iter_t i;
202 char oidhex[25];
203 Tcl_Obj *resultObj, *elemObj;
204
205 bson_iter_init( &i , data );
206 resultObj = Tcl_NewListObj(0, NULL);
207
208 while ( bson_iter_next( &i ) ){
209 bson_type_t t = bson_iter_type( &i );
210 nsfMongoTypes tag;
211 const char *key;
212
213 if ( t == 0 )
214 break;
215 key = bson_iter_key( &i );
216 /*fprintf(stderr, "BsonToList: key %s t %d string %d\n", key, t, bson_string);*/
217
218 switch ( t ){
219 case BSON_TYPE_INT32: tag = NSF_BSON_INT32; elemObj = Tcl_NewIntObj(bson_iter_int32( &i )); break;
220 case BSON_TYPE_INT64: tag = NSF_BSON_INT64; elemObj = Tcl_NewLongObj(bson_iter_int64( &i )); break;
221 case BSON_TYPE_DATE_TIME: tag = NSF_BSON_DATE_TIME; elemObj = Tcl_NewLongObj(bson_iter_date_time( &i )); break;
222 case BSON_TYPE_DOUBLE: tag = NSF_BSON_DOUBLE; elemObj = Tcl_NewDoubleObj(bson_iter_double( &i )); break;
223 case BSON_TYPE_BOOL: tag = NSF_BSON_BOOL; elemObj = Tcl_NewBooleanObj(bson_iter_bool( &i )); break;
224 case BSON_TYPE_REGEX: {
225 const char *options = NULL, *regex;
226
227 tag = NSF_BSON_REGEX;
228 regex = bson_iter_regex( &i, &options );
229 elemObj = Tcl_NewListObj(0, NULL);
230 Tcl_ListObjAppendElement(interp, elemObj, Tcl_NewStringObj(regex, -1));
231 Tcl_ListObjAppendElement(interp, elemObj, Tcl_NewStringObj(options, -1));
232 break;
233 }
234 case BSON_TYPE_UTF8: {
235 uint32_t utf8_len;
236 const char *string = bson_iter_utf8( &i, &utf8_len);
237
238 /*fprintf(stderr, "append UTF8: <%s> %d\n", string, utf8_len);*/
239 tag = NSF_BSON_STRING; elemObj = Tcl_NewStringObj(string, (int)utf8_len);
240 break;
241 }
242 case BSON_TYPE_MINKEY: tag = NSF_BSON_MINKEY; elemObj = Tcl_NewStringObj("null", 4); break;
243 case BSON_TYPE_MAXKEY: tag = NSF_BSON_MAXKEY; elemObj = Tcl_NewStringObj("null", 4); break;
244 case BSON_TYPE_NULL: tag = NSF_BSON_NULL; elemObj = Tcl_NewStringObj("null", 4); break;
245 case BSON_TYPE_OID: {
246 tag = NSF_BSON_OID;
247 bson_oid_to_string(bson_iter_oid(&i), oidhex);
248 elemObj = Tcl_NewStringObj(oidhex, -1);
249 break;
250 }
251 case BSON_TYPE_TIMESTAMP: {
252 uint32_t timestamp, increment;
253
254 tag = NSF_BSON_TIMESTAMP;
255 bson_iter_timestamp( &i, ×tamp, &increment );
256 elemObj = Tcl_NewListObj(0, NULL);
257 Tcl_ListObjAppendElement(interp, elemObj, Tcl_NewLongObj((long)timestamp));
258 Tcl_ListObjAppendElement(interp, elemObj, Tcl_NewLongObj((long)increment));
259 break;
260 }
261 case BSON_TYPE_DOCUMENT: {
262 const uint8_t *docbuf = NULL;
263 uint32_t doclen = 0;
264 bson_t b;
265
266 tag = NSF_BSON_DOCUMENT;
267 bson_iter_document(&i, &doclen, &docbuf);
268 bson_init_static(&b, docbuf, doclen);
269 elemObj = BsonToList(interp, &b , depth + 1 );
270 break;
271 }
272 case BSON_TYPE_ARRAY: {
273 const uint8_t *docbuf = NULL;
274 uint32_t doclen = 0;
275 bson_t b;
276
277 tag = NSF_BSON_ARRAY;
278 bson_iter_array(&i, &doclen, &docbuf);
279 bson_init_static(&b, docbuf, doclen);
280 elemObj = BsonToList(interp, &b , depth + 1 );
281 break;
282 }
283 case BSON_TYPE_DECIMAL128: {
284 bson_decimal128_t decimal128;
285 char string[BSON_DECIMAL128_STRING];
286
287 tag = NSF_BSON_DECIMAL128;
288 bson_iter_decimal128( &i, &decimal128);
289 bson_decimal128_to_string(&decimal128, string);
290 elemObj = Tcl_NewStringObj(string, -1);
291
292 break;
293 }
294 case BSON_TYPE_BINARY: {
295 uint32_t length;
296 const uint8_t *bytes;
297
298 tag = NSF_BSON_BINARY;
299 bson_iter_binary( &i, NULL /* subtype_t */, &length, &bytes);
300 elemObj = Tcl_NewByteArrayObj(bytes, (int)length);
301 break;
302 }
303 case BSON_TYPE_CODE: /* fall through */
304 case BSON_TYPE_CODEWSCOPE: /* fall through */
305 case BSON_TYPE_DBPOINTER: /* fall through */
306 case BSON_TYPE_EOD: /* fall through */
307 case BSON_TYPE_SYMBOL: /* fall through */
308 case BSON_TYPE_UNDEFINED: /* fall through */
309 default:
310 tag = NSF_BSON_UNKNOWN;
311 elemObj = Tcl_NewStringObj("", 0);
312 NsfLog(interp, NSF_LOG_WARN, "BsonToList: unknown type %d", t);
313 }
314
315 Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj(key, -1));
316 Tcl_ListObjAppendElement(interp, resultObj, NsfMongoGlobalObjs[tag]);
317 Tcl_ListObjAppendElement(interp, resultObj, elemObj);
318 }
319
320 return resultObj;
321 }
322
323 /*
324 *----------------------------------------------------------------------
325 *
326 * BsonTagToType --
327 *
328 * Convert a bson tag string to a bson_type. For the time being
329 * we compare as little as possible characters. In the future we
330 * might want to cache the bson tag in the Tcl_obj, maybe we can
331 * use Tcl_GetIndexFromObj();
332 *
333 * Results:
334 * bson_type.
335 *
336 * Side effects:
337 * None.
338 *
339 *----------------------------------------------------------------------
340 */
341 bson_type_t
BsonTagToType(Tcl_Interp * interp,const char * tag)342 BsonTagToType(Tcl_Interp *interp, const char *tag)
343 {
344 char firstChar = *tag;
345
346 switch (firstChar) {
347 case 'a': /* array */ return BSON_TYPE_ARRAY;
348 case 'b': /* bool */ return BSON_TYPE_BOOL;
349 case 'd':
350 if (*(tag + 1) == 'a') /* date */ return BSON_TYPE_DATE_TIME;
351 if (*(tag + 1) == 'o' && *(tag + 2) == 'c') /* document */ return BSON_TYPE_DOCUMENT;
352 if (*(tag + 1) == 'o' && *(tag + 2) == 'u') /* double */ return BSON_TYPE_DOUBLE;
353 break;
354 case 'i': /* int32|64 */
355 if (*(tag + 1) == 'n' && *(tag + 2) == 't' && *(tag + 3) == '3') return BSON_TYPE_INT32;
356 if (*(tag + 1) == 'n' && *(tag + 2) == 't' && *(tag + 3) == '6') return BSON_TYPE_INT64;
357 if (*(tag + 1) == 'n' && *(tag + 2) == 't') return BSON_TYPE_INT32;
358 break;
359 case 'm':
360 if (*(tag + 1) == 'i') /* minkey */ return BSON_TYPE_MINKEY;
361 if (*(tag + 1) == 'a') /* maxkey */ return BSON_TYPE_MAXKEY;
362 break;
363 case 'n': /* null */ return BSON_TYPE_NULL;
364 case 'o':
365 if (*(tag + 1) == 'i') /* oid */ return BSON_TYPE_OID;
366 break;
367 case 'r': /* regex */ return BSON_TYPE_REGEX;
368 case 's': /* string */ return BSON_TYPE_UTF8;
369 case 't': /* timestamp */ return BSON_TYPE_TIMESTAMP;
370 }
371
372 NsfLog(interp, NSF_LOG_WARN, "BsonTagToType: Treat unknown tag '%s' as string", tag);
373 return BSON_TYPE_UTF8;
374 }
375
376 /*
377 *----------------------------------------------------------------------
378 *
379 * BsonAppend --
380 *
381 * append a tagged element to a bson buffer.
382 *
383 * Results:
384 * Tcl result code.
385 *
386 * Side effects:
387 * Value appended to bson buffer.
388 *
389 *----------------------------------------------------------------------
390 */
391 static int
BsonAppend(Tcl_Interp * interp,bson_t * bbPtr,const char * name,const char * tag,Tcl_Obj * value)392 BsonAppend(Tcl_Interp *interp, bson_t *bbPtr, const char *name, const char *tag, Tcl_Obj *value)
393 {
394 int result = TCL_OK;
395 bson_type_t t = BsonTagToType(interp, tag);
396 int keyLength = (int)strlen(name);
397
398 /*fprintf(stderr, "BsonAppend: add name %s tag %s value '%s'\n", name, tag, ObjStr(value));*/
399
400 switch ( t ){
401 case BSON_TYPE_UTF8: {
402 const char* string = ObjStr(value);
403
404 bson_append_utf8(bbPtr, name, keyLength, string, (int)strlen(string));
405 break;
406 }
407 case BSON_TYPE_INT32: {
408 int32_t v;
409
410 result = Tcl_GetIntFromObj(interp, value, &v);
411 if (result != TCL_OK) break;
412 bson_append_int32(bbPtr, name, keyLength, v);
413 break;
414 }
415 case BSON_TYPE_DOUBLE: {
416 double v;
417
418 result = Tcl_GetDoubleFromObj(interp, value, &v);
419 if (result != TCL_OK) break;
420 bson_append_double(bbPtr, name, keyLength, v);
421 break;
422 }
423
424 case BSON_TYPE_BOOL: {
425 int v;
426 result = Tcl_GetBooleanFromObj(interp, value, &v);
427 if (result != TCL_OK) break;
428 bson_append_bool(bbPtr, name, keyLength, v);
429 break;
430 }
431 case BSON_TYPE_INT64: {
432 long v;
433
434 result = Tcl_GetLongFromObj(interp, value, &v);
435 if (result != TCL_OK) break;
436 bson_append_int64(bbPtr, name, keyLength, v);
437 break;
438 }
439 case BSON_TYPE_MAXKEY:
440 bson_append_maxkey(bbPtr, name, keyLength);
441 break;
442
443 case BSON_TYPE_MINKEY:
444 bson_append_minkey(bbPtr, name, keyLength);
445 break;
446
447 case BSON_TYPE_NULL: {
448 bson_append_null(bbPtr, name, keyLength);
449 break;
450 }
451 case BSON_TYPE_OID: {
452 bson_oid_t v;
453
454 bson_oid_init_from_string(&v, ObjStr(value));
455 bson_append_oid(bbPtr, name, keyLength, &v);
456 break;
457 }
458 case BSON_TYPE_REGEX: {
459 int objc = 0;
460 Tcl_Obj **objv;
461
462 result = Tcl_ListObjGetElements(interp, value, &objc, &objv);
463 if (result != TCL_OK || objc != 2) {
464 return NsfPrintError(interp, "invalid regexp representation: %s", ObjStr(value));
465 }
466 bson_append_regex(bbPtr, name, keyLength, ObjStr(objv[0]), ObjStr(objv[1]));
467 break;
468 }
469 case BSON_TYPE_DATE_TIME: {
470 long v;
471
472 result = Tcl_GetLongFromObj(interp, value, &v);
473 if (result != TCL_OK) break;
474 bson_append_date_time(bbPtr, name, keyLength, v);
475 break;
476 }
477 case BSON_TYPE_TIMESTAMP: {
478 int timestamp = 0, increment = 0, objc = 0;
479 Tcl_Obj **objv;
480
481 result = Tcl_ListObjGetElements(interp, value, &objc, &objv);
482 if (result != TCL_OK || objc != 2) {
483 return NsfPrintError(interp, "invalid timestamp: %s", ObjStr(value));
484 } else {
485 result = Tcl_GetIntFromObj(interp, objv[0], ×tamp);
486 if (result == TCL_OK) {
487 result = Tcl_GetIntFromObj(interp, objv[1], &increment);
488 }
489 if (result == TCL_OK) {
490 bson_append_timestamp(bbPtr, name, keyLength, (uint32_t)timestamp, (uint32_t)increment);
491 }
492 }
493 break;
494 }
495 case BSON_TYPE_DOCUMENT:
496 case BSON_TYPE_ARRAY: {
497 int i, objc;
498 Tcl_Obj **objv;
499 bson_t child, *childPtr = &child;
500
501 result = Tcl_ListObjGetElements(interp, value, &objc, &objv);
502 if (result != TCL_OK || ((objc % 3) != 0)) {
503 return NsfPrintError(interp, "invalid %s value contain multiple of 3 elements %s", tag, ObjStr(value));
504 }
505
506 if (t == BSON_TYPE_DOCUMENT) {
507 bson_append_document_begin(bbPtr, name, keyLength, childPtr);
508 } else {
509 bson_append_array_begin(bbPtr, name, keyLength, childPtr);
510 }
511 for (i = 0; i< objc; i += 3) {
512 /*fprintf(stderr, "value %s, i %d, [0]: %s, [1]: %s, [2]: %s\n", ObjStr(value), i,
513 ObjStr(objv[i]), ObjStr(objv[i+1]), ObjStr(objv[i+2]));*/
514 result = BsonAppend(interp, childPtr, ObjStr(objv[i]), ObjStr(objv[i+1]), objv[i+2]);
515 if (result != TCL_OK) break;
516 }
517
518 if (t == BSON_TYPE_DOCUMENT) {
519 bson_append_document_end(bbPtr, childPtr);
520 } else {
521 bson_append_array_end(bbPtr, childPtr);
522 }
523 break;
524 }
525 case BSON_TYPE_DECIMAL128: {
526 bson_decimal128_t decimal128;
527
528 bson_decimal128_from_string(ObjStr(value), &decimal128);
529 bson_append_decimal128(bbPtr, name, keyLength, &decimal128);
530 break;
531 }
532 case BSON_TYPE_BINARY: {
533 int length;
534 const uint8_t *data = Tcl_GetByteArrayFromObj(value, &length);
535 bson_append_binary(bbPtr, name, keyLength, 0x00 /*bson_subtype_t*/,
536 data, (uint32_t)length);
537 break;
538 }
539 case BSON_TYPE_DBPOINTER:
540 case BSON_TYPE_CODE:
541 case BSON_TYPE_SYMBOL:
542 case BSON_TYPE_CODEWSCOPE:
543 return NsfPrintError(interp, "tag %s not handled yet", tag);
544 break;
545
546 case BSON_TYPE_UNDEFINED:
547 case BSON_TYPE_EOD:
548 break;
549
550 /* no default here, to get the warning to the compilation log for the time being */
551 }
552 return result;
553 }
554
555 /*
556 *----------------------------------------------------------------------
557 *
558 * BsonAppendObjv --
559 *
560 * Append all elements of objv to an uninitialized bson buffer.
561 *
562 * Results:
563 * Tcl result code.
564 *
565 * Side effects:
566 * Value appended to bson buffer.
567 *
568 *----------------------------------------------------------------------
569 */
570 static int
BsonAppendObjv(Tcl_Interp * interp,bson_t * bPtr,int objc,Tcl_Obj ** objv)571 BsonAppendObjv(Tcl_Interp *interp, bson_t *bPtr, int objc, Tcl_Obj **objv)
572 {
573 int i, result = TCL_OK;
574
575 bson_init(bPtr);
576 for (i = 0; i < objc; i += 3) {
577 char *name = ObjStr(objv[i]);
578 char *tag = ObjStr(objv[i+1]);
579 Tcl_Obj *value = objv[i+2];
580
581 /*fprintf(stderr, "adding pair '%s' (%s) '%s'\n", name, tag, ObjStr(value));*/
582 result = BsonAppend(interp, bPtr, name, tag, value);
583 if (result != TCL_OK) {
584 break;
585 }
586 }
587 return result;
588 }
589
590
591 /***********************************************************************
592 * Define the API functions
593 ***********************************************************************/
594 /*
595 cmd json::generate NsfMongoJsonGenerate {
596 {-argName "list" -required 1 -type tclobj}
597 }
598 */
599 static int
NsfMongoJsonGenerate(Tcl_Interp * interp,Tcl_Obj * listObj)600 NsfMongoJsonGenerate(Tcl_Interp *interp, Tcl_Obj *listObj)
601 {
602 bson_t list, *listPtr = &list;
603 size_t length;
604 int result, objc;
605 Tcl_Obj **objv;
606
607 result = Tcl_ListObjGetElements(interp, listObj, &objc, &objv);
608 if (result != TCL_OK || ((objc % 3) != 0)) {
609 return NsfPrintError(interp, "%s: must contain a multiple of 3 elements", ObjStr(listObj));
610 }
611
612 result = BsonAppendObjv(interp, listPtr, objc, objv);
613 if (result == TCL_OK) {
614 char *jsonString;
615
616 jsonString = bson_as_json(listPtr, &length);
617 if (jsonString != NULL) {
618 Tcl_SetObjResult(interp, Tcl_NewStringObj(jsonString, (int)length));
619 bson_free(jsonString);
620 } else {
621 result = NsfPrintError(interp, "invalid bson string: %s", ObjStr(listObj));
622 }
623
624 bson_destroy( listPtr );
625 }
626
627 return result;
628 }
629 /*
630 cmd json::parse NsfMongoJsonParse {
631 {-argName "json" -required 1 -type tclobj}
632 }
633 */
634 static int
NsfMongoJsonParse(Tcl_Interp * interp,Tcl_Obj * jsonObj)635 NsfMongoJsonParse(Tcl_Interp *interp, Tcl_Obj *jsonObj)
636 {
637 bson_t bson, *bsonPtr = &bson;
638 const char *jsonString;
639 int result, jsonLength;
640 bson_error_t bsonError;
641
642 jsonString = Tcl_GetStringFromObj(jsonObj, &jsonLength);
643
644 if (bson_init_from_json (bsonPtr, jsonString,jsonLength, &bsonError) == true) {
645 Tcl_SetObjResult(interp, BsonToList(interp, bsonPtr, 0));
646 bson_destroy( bsonPtr );
647 result = TCL_OK;
648 } else {
649 result = NsfPrintError(interp, "mongo::json::parse: error: %s", bsonError.message);
650 }
651
652 return result;
653 }
654
655 /*
656 cmd close NsfMongoClose {
657 {-argName "conn" -required 1 -type mongoc_client_t -withObj 1}
658 }
659 */
660 static int
NsfMongoClose(Tcl_Interp * UNUSED (interp),mongoc_client_t * connPtr,Tcl_Obj * connObj)661 NsfMongoClose(Tcl_Interp *UNUSED(interp), mongoc_client_t *connPtr, Tcl_Obj *connObj)
662 {
663 #if defined(USE_CLIENT_POOL)
664 mongoc_client_pool_push(mongoClientPool, connPtr);
665 #else
666 mongoc_client_destroy(connPtr);
667 #endif
668 Nsf_PointerDelete(ObjStr(connObj), connPtr, 0);
669
670 return TCL_OK;
671 }
672
673 /*
674 cmd connect NsfMongoConnect {
675 {-argName "-uri" -required 0 -nrargs 1}
676 }
677 */
678 static int
NsfMongoConnect(Tcl_Interp * interp,const char * uri)679 NsfMongoConnect(Tcl_Interp *interp, const char *uri)
680 {
681 char channelName[80];
682 mongoc_client_t *clientPtr;
683
684 if (uri == NULL) {
685 uri = "mongodb://127.0.0.1:27017/";
686 }
687
688 #if defined(USE_CLIENT_POOL)
689 NsfMutexLock(&poolMutex);
690
691 if (mongoClientPool == NULL) {
692 mongoUri = mongoc_uri_new(uri);
693 NsfLog(interp, NSF_LOG_NOTICE, "nsf::mongo::connect: creating pool with uri %s", uri);
694 mongoClientPool = mongoc_client_pool_new(mongoUri);
695 }
696
697 NsfMutexUnlock(&poolMutex);
698 clientPtr = mongoc_client_pool_pop(mongoClientPool);
699 #else
700 clientPtr = mongoc_client_new(uri);
701 #endif
702
703 if (clientPtr == NULL) {
704 return NsfPrintError(interp, "failed to parse Mongo URI");
705 }
706
707 /*
708 * Make an entry in the symbol table and return entry name it as
709 * result.
710 */
711 if (Nsf_PointerAdd(interp, channelName, 80u, "mongoc_client_t", clientPtr) != TCL_OK) {
712 mongoc_client_destroy(clientPtr);
713 return TCL_ERROR;
714 }
715
716 Tcl_SetObjResult(interp, Tcl_NewStringObj(channelName, -1));
717
718 return TCL_OK;
719 }
720
721 /*
722 cmd run NsfMongoRunCmd {
723 {-argName "-nocomplain" -required 0 -nrargs 0}
724 {-argName "conn" -required 1 -type mongoc_client_t}
725 {-argName "db" -required 1}
726 {-argName "cmd" -required 1 -type tclobj}
727 }
728 */
729 static int
NsfMongoRunCmd(Tcl_Interp * interp,int withNocomplain,mongoc_client_t * clientPtr,const char * db,Tcl_Obj * cmdObj)730 NsfMongoRunCmd(Tcl_Interp *interp, int withNocomplain, mongoc_client_t *clientPtr,
731 const char *db, Tcl_Obj *cmdObj)
732 {
733 bson_t cmd, *cmdPtr = &cmd, reply, *replyPtr = &reply;
734 mongoc_read_prefs_t *readPrefsPtr = NULL; /* TODO: not used */
735 bson_error_t bsonError;
736 int result, objc;
737 Tcl_Obj **objv;
738
739 result = Tcl_ListObjGetElements(interp, cmdObj, &objc, &objv);
740 if (result != TCL_OK || ((objc % 3) != 0)) {
741 return NsfPrintError(interp, "%s: must contain a multiple of 3 elements", ObjStr(cmdObj));
742 }
743 BsonAppendObjv(interp, cmdPtr, objc, objv);
744
745 /*mongo_clear_errors( connPtr );*/
746 result = mongoc_client_command_simple( clientPtr, db, cmdPtr, readPrefsPtr, replyPtr, &bsonError);
747 bson_destroy( cmdPtr );
748
749 if (withNocomplain == 0 && result == 0) {
750 return NsfPrintError(interp, "mongo::run: command '%s' returned error: %s",
751 ObjStr(cmdObj), bsonError.message);
752 }
753
754 Tcl_SetObjResult(interp, BsonToList(interp, replyPtr, 0));
755 bson_destroy(replyPtr);
756
757 return TCL_OK;
758 }
759
760 /*
761 cmd status NsfMongoStatus {
762 {-argName "conn" -required 1 -type mongoc_client_t -withObj 1}
763 }
764 */
765 static int
NsfMongoStatus(Tcl_Interp * interp,mongoc_client_t * clientPtr,Tcl_Obj * UNUSED (clientObj))766 NsfMongoStatus(Tcl_Interp *interp, mongoc_client_t *clientPtr, Tcl_Obj *UNUSED(clientObj))
767 {
768 mongoc_read_prefs_t *readPrefs = NULL; /* TODO: not handled */
769 bson_t reply, *replyPtr = &reply;
770 bson_error_t bsonError;
771 int result = TCL_OK;
772 bson_t cmd = BSON_INITIALIZER;
773 bool ret;
774
775 BSON_APPEND_INT32(&cmd, "serverStatus", 1);
776 ret = mongoc_client_command_simple(clientPtr, "admin", &cmd, readPrefs, replyPtr, &bsonError);
777 bson_destroy(&cmd);
778
779 if (likely(ret != 0)) {
780 Tcl_SetObjResult(interp, BsonToList(interp, replyPtr, 0));
781 } else {
782 result = NsfPrintError(interp, "mongo::status: error: %s", bsonError.message);
783 }
784
785 bson_destroy(replyPtr);
786 return result;
787 }
788
789
790 /*
791 cmd collection::open NsfCollectionOpen {
792 {-argName "conn" -required 1 -type mongoc_client_t}
793 {-argName "dbname" -required 1}
794 {-argName "collectionname" -required 1}
795 }
796 */
797 int
NsfCollectionOpen(Tcl_Interp * interp,mongoc_client_t * clientPtr,const char * dbName,const char * collectionName)798 NsfCollectionOpen(Tcl_Interp *interp,
799 mongoc_client_t *clientPtr,
800 const char *dbName,
801 const char *collectionName)
802 {
803 int result = TCL_ERROR;
804 mongoc_collection_t *collectionPtr;
805
806 collectionPtr = mongoc_client_get_collection(clientPtr, dbName, collectionName);
807 if (collectionPtr != NULL) {
808 char buffer[80];
809
810 if (Nsf_PointerAdd(interp, buffer, 80u, "mongoc_collection_t", collectionPtr) == TCL_OK) {
811 Tcl_SetObjResult(interp, Tcl_NewStringObj(buffer, -1));
812 result = TCL_OK;
813 } else {
814 mongoc_collection_destroy(collectionPtr);
815 result = TCL_ERROR;
816 }
817 }
818
819 if (collectionPtr == NULL) {
820 result = NsfPrintError(interp,
821 "collection::open: could not open collection: %s.%s",
822 dbName, collectionName);
823 }
824
825 return result;
826 }
827
828 /*
829 cmd collection::close NsfCollectionClose {
830 {-argName "collection" -required 1 -type mongoc_collection_t -withObj 1}
831 }
832 */
833 static int
NsfCollectionClose(Tcl_Interp * UNUSED (interp),mongoc_collection_t * collectionPtr,Tcl_Obj * clientObj)834 NsfCollectionClose(Tcl_Interp *UNUSED(interp), mongoc_collection_t *collectionPtr, Tcl_Obj *clientObj)
835 {
836 mongoc_collection_destroy(collectionPtr);
837 Nsf_PointerDelete(ObjStr(clientObj), collectionPtr, 0);
838
839 return TCL_OK;
840 }
841
842 /*
843 cmd collection::count NsfMongoCollectionCount {
844 {-argName "collection" -required 1 -type mongoc_collection_t}
845 {-argName "query" -required 1 -type tclobj}
846 }
847 */
848 static int
NsfMongoCollectionCount(Tcl_Interp * interp,mongoc_collection_t * collectionPtr,Tcl_Obj * queryObj)849 NsfMongoCollectionCount(Tcl_Interp *interp,
850 mongoc_collection_t *collectionPtr,
851 Tcl_Obj *queryObj)
852 {
853 int objc, result;
854 int64_t count;
855 Tcl_Obj **objv;
856 bson_t query, *queryPtr = &query;
857 bson_error_t bsonError;
858 /*bson_t* opts = BCON_NEW("skip", BCON_INT64(5));*/
859
860 result = Tcl_ListObjGetElements(interp, queryObj, &objc, &objv);
861 if (result != TCL_OK || ((objc % 3) != 0)) {
862 return NsfPrintError(interp, "%s: must contain a multiple of 3 elements", ObjStr(queryObj));
863 }
864
865 BsonAppendObjv(interp, queryPtr, objc, objv);
866
867 count = mongoc_collection_count_documents(collectionPtr,
868 queryPtr,
869 NULL /* opts */,
870 NULL /* read preferences */,
871 NULL /* replyPtr */,
872 &bsonError);
873 if (count == -1) {
874 bson_destroy( queryPtr );
875 return NsfPrintError(interp, "mongo::collection::count: error: %s", bsonError.message);
876 }
877
878 bson_destroy( queryPtr );
879 Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)count));
880
881 return TCL_OK;
882 }
883
884 /*
885 cmd "collection::delete" NsfMongoCollectionDelete {
886 {-argName "collection" -required 1 -type mongoc_collection_t}
887 {-argName "condition" -required 1 -type tclobj}
888 }
889 */
890 static int
NsfMongoCollectionDelete(Tcl_Interp * interp,mongoc_collection_t * collectionPtr,Tcl_Obj * conditionObj)891 NsfMongoCollectionDelete(Tcl_Interp *interp,
892 mongoc_collection_t *collectionPtr,
893 Tcl_Obj *conditionObj)
894 {
895 int objc, result, success;
896 Tcl_Obj **objv;
897 bson_t query, *queryPtr = &query;
898 bson_error_t bsonError;
899 mongoc_remove_flags_t removeFlags = 0; /* TODO: not handled */
900 /* MONGOC_DELETE_SINGLE_REMOVE = 1 << 0,**/
901 const mongoc_write_concern_t *writeConcern = NULL; /* TODO: not handled yet */
902
903 result = Tcl_ListObjGetElements(interp, conditionObj, &objc, &objv);
904 if (result != TCL_OK || ((objc % 3) != 0)) {
905 return NsfPrintError(interp, "%s: must contain a multiple of 3 elements", ObjStr(conditionObj));
906 }
907
908 BsonAppendObjv(interp, queryPtr, objc, objv);
909 success = mongoc_collection_remove(collectionPtr, removeFlags, queryPtr, writeConcern, &bsonError);
910
911 if (success == 0) {
912 result = NsfPrintError(interp, "mongo::collection::delete: error: %s", bsonError.message);
913 }
914 bson_destroy(queryPtr);
915 return result;
916 }
917
918 /*
919 cmd "collection::index" NsfMongoCollectionIndex {
920 {-argName "collection" -required 1 -type mongoc_collection_t}
921 {-argName "attributes" -required 1 -type tclobj}
922 {-argName "-name" -required 0 -nrargs 1}
923 {-argName "-background" -required 0 -nrargs 0}
924 {-argName "-dropdups" -required 0 -nrargs 0}
925 {-argName "-sparse" -required 0 -nrargs 0}
926 {-argName "-ttl" -required 0 -nrargs 1 -type int32}
927 {-argName "-unique" -required 0 -nrargs 0}
928 }
929 */
930
931 static int
NsfMongoCollectionIndex(Tcl_Interp * interp,mongoc_collection_t * collectionPtr,Tcl_Obj * attributesObj,const char * withName,int withBackground,int withDropdups,int withSparse,int withTtl,int withUnique)932 NsfMongoCollectionIndex(Tcl_Interp *interp,
933 mongoc_collection_t *collectionPtr,
934 Tcl_Obj *attributesObj,
935 const char *withName,
936 int withBackground,
937 int withDropdups,
938 int withSparse,
939 int withTtl,
940 int withUnique)
941 {
942 int objc, result, success = 0;
943 Tcl_Obj **objv;
944 bson_t keys, *keysPtr = &keys;
945 bson_error_t bsonError;
946 mongoc_index_opt_t options;
947 bson_t *create_indexes;
948 char *index_name;
949 const char *collection_name;
950
951 result = Tcl_ListObjGetElements(interp, attributesObj, &objc, &objv);
952 if (result != TCL_OK || ((objc % 3) != 0)) {
953 return NsfPrintError(interp, "%s: must contain a multiple of 3 elements", ObjStr(attributesObj));
954 }
955
956 BsonAppendObjv(interp, keysPtr, objc, objv);
957
958 index_name = mongoc_collection_keys_to_index_string(keysPtr);
959 collection_name = mongoc_collection_get_name(collectionPtr);
960
961 create_indexes = BCON_NEW("createIndexes",
962 BCON_UTF8(collection_name),
963 "indexes",
964 "[",
965 "{",
966 "key",
967 BCON_DOCUMENT(keysPtr),
968 "name",
969 BCON_UTF8(index_name),
970 "}",
971 "]");
972 mongoc_index_opt_init(&options);
973
974 if (withBackground != 0) {options.background = 1;}
975 if (withDropdups != 0) {options.drop_dups = 1;}
976 if (withSparse != 0) {options.sparse = 1;}
977 if (withUnique != 0) {options.unique = 1;}
978 if (withTtl != 0) {options.expire_after_seconds = withTtl;}
979 if (withName != 0) {options.name = withName;}
980 /* TODO: not handled: is_initialized, v, weights, default_language, language_override, padding */
981
982 success = mongoc_collection_write_command_with_opts(
983 collectionPtr,
984 create_indexes,
985 NULL /* opts */,
986 NULL /*&reply*/,
987 &bsonError);
988 bson_destroy(keysPtr);
989 bson_free(index_name);
990 bson_destroy(create_indexes);
991
992 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(success));
993 return TCL_OK;
994 }
995
996
997 /*
998 cmd "collection::insert" NsfMongoCollectionInsert {
999 {-argName "collection" -required 1 -type mongoc_collection_t}
1000 {-argName "values" -required 1 -type tclobj}
1001 }
1002 */
NsfMongoCollectionInsert(Tcl_Interp * interp,mongoc_collection_t * collectionPtr,Tcl_Obj * valuesObj)1003 static int NsfMongoCollectionInsert(Tcl_Interp *interp,
1004 mongoc_collection_t *collectionPtr,
1005 Tcl_Obj *valuesObj)
1006 {
1007 int i, objc, result, success;
1008 Tcl_Obj **objv;
1009 bson_t bson, *bsonPtr = &bson;
1010 bson_oid_t oid;
1011 bson_error_t bsonError;
1012 mongoc_insert_flags_t insertFlags = MONGOC_INSERT_NO_VALIDATE; /* otherwise, we can't insert a DBRef */
1013
1014 /* TODO: insertFlags not handled:
1015 MONGOC_INSERT_NONE = 0,
1016 MONGOC_INSERT_CONTINUE_ON_ERROR = 1 << 0,
1017 MONGOC_INSERT_NO_VALIDATE = 1 << 31,
1018 */
1019 const mongoc_write_concern_t *writeConcern = NULL; /* TODO: not handled yet */
1020
1021 result = Tcl_ListObjGetElements(interp, valuesObj, &objc, &objv);
1022 if (result != TCL_OK || ((objc % 3) != 0)) {
1023 return NsfPrintError(interp, "%s: must contain a multiple of 3 elements", ObjStr(valuesObj));
1024 }
1025
1026 bson_init(bsonPtr);
1027 bson_oid_init(&oid, NULL);
1028 bson_append_oid(bsonPtr, "_id", 3, &oid);
1029
1030 for (i = 0; i < objc; i += 3) {
1031 const char *name = ObjStr(objv[i]);
1032 const char *tag = ObjStr(objv[i+1]);
1033 Tcl_Obj *value = objv[i+2];
1034
1035 /*fprintf(stderr, "adding pair '%s' (%s) '%s'\n", name, tag, ObjStr(value));*/
1036 BsonAppend(interp, bsonPtr, name, tag, value);
1037 }
1038
1039 success = mongoc_collection_insert(collectionPtr, insertFlags, bsonPtr, writeConcern, &bsonError);
1040
1041 if (success == 0) {
1042 result = NsfPrintError(interp, "mongo::collection::insert: error: %s", bsonError.message);
1043 } else {
1044 Tcl_SetObjResult(interp, BsonToList(interp, bsonPtr, 0));
1045 }
1046
1047 bson_destroy(bsonPtr);
1048
1049 return result;
1050 }
1051
1052 /*
1053 cmd collection::query NsfMongoCollectionQuery {
1054 {-argName "collection" -required 1 -type mongoc_collection_t}
1055 {-argName "filter" -required 1 -type tclobj}
1056 {-argName "-opts" -required 0 -nrargs 1 -type tclobj}
1057 }
1058 */
1059 static int
NsfMongoCollectionQuery(Tcl_Interp * interp,mongoc_collection_t * collectionPtr,Tcl_Obj * filterObj,Tcl_Obj * withOptsObj)1060 NsfMongoCollectionQuery(Tcl_Interp *interp,
1061 mongoc_collection_t *collectionPtr,
1062 Tcl_Obj *filterObj, Tcl_Obj *withOptsObj)
1063 {
1064 int objc1, objc2 = 0, result;
1065 Tcl_Obj **objv1, **objv2 = NULL, *resultObj;
1066 mongoc_cursor_t *cursor;
1067 bson_t filter, *const filterPtr = &filter;
1068 bson_t opts, *const optsPtr = &opts;
1069 const bson_t *nextPtr;
1070 mongoc_read_prefs_t *readPrefsPtr = NULL; /* TODO: not handled */
1071
1072 /*fprintf(stderr, "NsfMongoQuery: namespace %s withLimit %d withSkip %d\n",
1073 namespace, withLimit, withSkip);*/
1074
1075 result = Tcl_ListObjGetElements(interp, filterObj, &objc1, &objv1);
1076 if (result != TCL_OK || ((objc1 % 3) != 0)) {
1077 return NsfPrintError(interp, "%s: must contain a multiple of 3 elements", ObjStr(filterObj));
1078 }
1079 if (withOptsObj != NULL) {
1080 result = Tcl_ListObjGetElements(interp, withOptsObj, &objc2, &objv2);
1081 if (result != TCL_OK || ((objc2 % 3) != 0)) {
1082 return NsfPrintError(interp, "%s: must contain a multiple of 3 elements", ObjStr(withOptsObj));
1083 }
1084 } else {
1085 objc2 = 0;
1086 }
1087
1088 BsonAppendObjv(interp, filterPtr, objc1, objv1);
1089 BsonAppendObjv(interp, optsPtr, objc2, objv2);
1090
1091 resultObj = Tcl_NewListObj(0, NULL);
1092
1093 cursor = mongoc_collection_find_with_opts( collectionPtr,
1094 filterPtr,
1095 optsPtr,
1096 readPrefsPtr);
1097
1098 while( mongoc_cursor_next( cursor, &nextPtr ) == 1 ) {
1099 Tcl_ListObjAppendElement(interp, resultObj, BsonToList(interp, nextPtr, 0));
1100 }
1101
1102 mongoc_cursor_destroy( cursor );
1103 bson_destroy( filterPtr );
1104 bson_destroy( optsPtr );
1105
1106 Tcl_SetObjResult(interp, resultObj);
1107
1108 return TCL_OK;
1109 }
1110
1111 /*
1112 cmd "collection::stats" NsfMongoCollectionStats {
1113 {-argName "collection" -required 1 -type mongoc_collection_t}
1114 {-argName "-options" -required 0 -type tclobj}
1115 }
1116 */
1117 static int
NsfMongoCollectionStats(Tcl_Interp * interp,mongoc_collection_t * collectionPtr,Tcl_Obj * optionsObj)1118 NsfMongoCollectionStats(Tcl_Interp *interp,
1119 mongoc_collection_t *collectionPtr,
1120 Tcl_Obj *optionsObj)
1121 {
1122 int objc = 0, success, result;
1123 Tcl_Obj **objv = NULL;
1124 bson_t options, *optionsPtr = NULL;
1125 bson_t stats, *statsPtr = &stats;
1126 bson_t cmd = BSON_INITIALIZER;
1127 bson_iter_t iter;
1128 bson_error_t bsonError;
1129
1130 if (optionsObj != NULL) {
1131 result = Tcl_ListObjGetElements(interp, optionsObj, &objc, &objv);
1132
1133 if (result != TCL_OK || ((objc % 3) != 0)) {
1134 return NsfPrintError(interp, "%s: must contain a multiple of 3 elements", ObjStr(optionsObj));
1135 }
1136 optionsPtr = &options;
1137 BsonAppendObjv(interp, optionsPtr, objc, objv);
1138 }
1139
1140 if (optionsPtr != NULL && bson_iter_init_find(&iter, optionsPtr, "scale")
1141 && !BSON_ITER_HOLDS_INT32 (&iter)) {
1142 bson_set_error(&bsonError,
1143 MONGOC_ERROR_BSON,
1144 MONGOC_ERROR_BSON_INVALID,
1145 "'scale' must be an int32 value.");
1146 success = 0;
1147 } else {
1148
1149 BSON_APPEND_UTF8(&cmd, "collStats", mongoc_collection_get_name(collectionPtr));
1150
1151 if (optionsPtr != NULL) {
1152 bson_concat(&cmd, optionsPtr);
1153 }
1154 success = mongoc_collection_command_simple(collectionPtr,
1155 &cmd,
1156 mongoc_collection_get_read_prefs(collectionPtr),
1157 statsPtr,
1158 &bsonError);
1159 bson_destroy(&cmd);
1160 }
1161
1162 if (optionsPtr != NULL) {
1163 bson_destroy(optionsPtr);
1164 }
1165
1166 if (success != 0) {
1167 Tcl_SetObjResult(interp, BsonToList(interp, statsPtr, 0));
1168 bson_destroy(statsPtr);
1169 result = TCL_OK;
1170 } else {
1171 result = NsfPrintError(interp, "mongo::collection::stats: error: %s", bsonError.message);
1172 }
1173 return result;
1174 }
1175
1176 /*
1177 cmd "collection::update" NsfMongoCollectionUpdate {
1178 {-argName "collection" -required 1 -type mongoc_collection_t}
1179 {-argName "cond" -required 1 -type tclobj}
1180 {-argName "values" -required 1 -type tclobj}
1181 {-argName "-upsert" -required 0 -nrargs 0}
1182 {-argName "-all" -required 0 -nrargs 0}
1183 }
1184 */
1185 static int
NsfMongoCollectionUpdate(Tcl_Interp * interp,mongoc_collection_t * collectionPtr,Tcl_Obj * conditionObj,Tcl_Obj * valuesObj,int withUpsert,int withAll)1186 NsfMongoCollectionUpdate(Tcl_Interp *interp,
1187 mongoc_collection_t *collectionPtr,
1188 Tcl_Obj *conditionObj, Tcl_Obj *valuesObj,
1189 int withUpsert, int withAll) {
1190
1191 const mongoc_write_concern_t *writeConcern = NULL; /* TODO: not handled yet */
1192 mongoc_update_flags_t updateFlags = MONGOC_UPDATE_NO_VALIDATE; /* for dbrefs */
1193 bson_error_t bsonError;
1194 bson_t cond, *condPtr = &cond, values, *valuesPtr = &values;
1195 int objc, result, success;
1196 Tcl_Obj **objv;
1197
1198 result = Tcl_ListObjGetElements(interp, conditionObj, &objc, &objv);
1199 if (result != TCL_OK || ((objc % 3) != 0)) {
1200 return NsfPrintError(interp, "%s: must contain a multiple of 3 elements", ObjStr(conditionObj));
1201 }
1202
1203 BsonAppendObjv(interp, condPtr, objc, objv);
1204
1205 result = Tcl_ListObjGetElements(interp, valuesObj, &objc, &objv);
1206 if (result != TCL_OK || ((objc % 3) != 0)) {
1207 bson_destroy(condPtr);
1208 return NsfPrintError(interp, "%s: must contain a multiple of 3 elements", ObjStr(valuesObj));
1209 }
1210
1211 BsonAppendObjv(interp, valuesPtr, objc, objv);
1212
1213 if (withUpsert != 0) {updateFlags |= MONGOC_UPDATE_UPSERT;}
1214 if (withAll != 0) {updateFlags |= MONGOC_UPDATE_MULTI_UPDATE;}
1215
1216 success = mongoc_collection_update(collectionPtr, updateFlags, condPtr, valuesPtr, writeConcern, &bsonError);
1217
1218 if (success == 0) {
1219 result = NsfPrintError(interp, "mongo::collection::delete: error: %s", bsonError.message);
1220 }
1221
1222 return result;
1223 }
1224
1225 /***********************************************************************
1226 * Cursor interface
1227 ***********************************************************************/
1228 /*
1229 cmd cursor::aggregate NsfMongoCursorAggregate {
1230 {-argName "collection" -required 1 -type mongoc_collection_t}
1231 {-argName "pipeline" -required 1 -type tclobj}
1232 {-argName "options" -required 1 -type tclobj}
1233 {-argName "-tailable" -required 0 -nrargs 0}
1234 {-argName "-awaitdata" -required 0 -nrargs 0}
1235 }
1236 */
1237 static int
NsfMongoCursorAggregate(Tcl_Interp * interp,mongoc_collection_t * collectionPtr,Tcl_Obj * pipelineObj,Tcl_Obj * optionsObj,int withTailable,int withAwaitdata)1238 NsfMongoCursorAggregate(Tcl_Interp *interp,
1239 mongoc_collection_t *collectionPtr,
1240 Tcl_Obj *pipelineObj,
1241 Tcl_Obj *optionsObj,
1242 int withTailable,
1243 int withAwaitdata)
1244 {
1245 int objc1, objc2, result;
1246 mongoc_query_flags_t queryFlags = 0;
1247 Tcl_Obj **objv1, **objv2 = NULL;
1248 mongoc_cursor_t *cursor;
1249 bson_t pipeline, *pipelinePtr = &pipeline;
1250 bson_t options, *optionsPtr = &options;
1251 mongoc_read_prefs_t *readPrefsPtr = NULL; /* TODO: not used */
1252
1253 result = Tcl_ListObjGetElements(interp, pipelineObj, &objc1, &objv1);
1254 if (result != TCL_OK || ((objc1 % 3) != 0)) {
1255 return NsfPrintError(interp, "%s: must contain a multiple of 3 elements", ObjStr(pipelineObj));
1256 }
1257 result = Tcl_ListObjGetElements(interp, optionsObj, &objc2, &objv2);
1258 if (result != TCL_OK || ((objc2 % 3) != 0)) {
1259 return NsfPrintError(interp, "%s: must contain a multiple of 3 elements", ObjStr(optionsObj));
1260 }
1261
1262 BsonAppendObjv(interp, pipelinePtr, objc1, objv1);
1263 BsonAppendObjv(interp, optionsPtr, objc2, objv2);
1264
1265 /*
1266 * The last field of mongo_find is options, semantics are described here
1267 * https://www.mongodb.org/display/DOCS/Mongo+Wire+Protocol#MongoWireProtocol-OPQUERY
1268 */
1269 if (withTailable != 0) {
1270 queryFlags |= MONGOC_QUERY_TAILABLE_CURSOR;
1271 }
1272 if (withAwaitdata != 0) {
1273 queryFlags |= MONGOC_QUERY_AWAIT_DATA;
1274 }
1275 /* TODO: query flags:
1276 MONGOC_QUERY_SLAVE_OK = 1 << 2,
1277 MONGOC_QUERY_OPLOG_REPLAY = 1 << 3,
1278 MONGOC_QUERY_NO_CURSOR_TIMEOUT = 1 << 4,
1279 MONGOC_QUERY_EXHAUST = 1 << 6,
1280 MONGOC_QUERY_PARTIAL = 1 << 7,
1281 */
1282 cursor = mongoc_collection_aggregate(collectionPtr, queryFlags,
1283 pipelinePtr, optionsPtr,
1284 readPrefsPtr);
1285 if (cursor != NULL) {
1286 char buffer[80];
1287
1288 if (Nsf_PointerAdd(interp, buffer, 80u, "mongoc_cursor_t", cursor) == TCL_OK) {
1289 Tcl_SetObjResult(interp, Tcl_NewStringObj(buffer, -1));
1290 } else {
1291 mongoc_cursor_destroy( cursor );
1292 result = TCL_ERROR;
1293 }
1294 } else {
1295 Tcl_ResetResult(interp);
1296 }
1297
1298 bson_destroy( pipelinePtr );
1299 bson_destroy( optionsPtr );
1300
1301 return result;
1302 }
1303
1304 /*
1305 cmd cursor::find NsfMongoCursorFind {
1306 {-argName "collection" -required 1 -type mongoc_collection_t}
1307 {-argName "filter" -required 1 -type tclobj}
1308 {-argName "-opts" -required 0 -nrargs 1 -type tclobj}
1309 }
1310 */
1311 static int
NsfMongoCursorFind(Tcl_Interp * interp,mongoc_collection_t * collectionPtr,Tcl_Obj * filterObj,Tcl_Obj * withOptsObj)1312 NsfMongoCursorFind(Tcl_Interp *interp,
1313 mongoc_collection_t *collectionPtr,
1314 Tcl_Obj *filterObj,
1315 Tcl_Obj *withOptsObj)
1316 {
1317 int objc1, objc2 = 0, result;
1318 Tcl_Obj **objv1, **objv2 = NULL;
1319 mongoc_cursor_t *cursor;
1320 bson_t filter, *filterPtr = &filter;
1321 bson_t opts, *optsPtr = &opts;
1322 mongoc_read_prefs_t *readPrefsPtr = NULL; /* TODO: not used */
1323
1324 /*fprintf(stderr, "NsfMongoQuery: namespace %s withLimit %d withSkip %d\n",
1325 namespace, withLimit, withSkip);*/
1326
1327 result = Tcl_ListObjGetElements(interp, filterObj, &objc1, &objv1);
1328 if (result != TCL_OK || ((objc1 % 3) != 0)) {
1329 return NsfPrintError(interp, "%s: must contain a multiple of 3 elements", ObjStr(filterObj));
1330 }
1331 if (withOptsObj != NULL) {
1332 result = Tcl_ListObjGetElements(interp, withOptsObj, &objc2, &objv2);
1333 if (result != TCL_OK || ((objc2 % 3) != 0)) {
1334 return NsfPrintError(interp, "%s: must contain a multiple of 3 elements", ObjStr(withOptsObj));
1335 }
1336 }
1337
1338 BsonAppendObjv(interp, filterPtr, objc1, objv1);
1339 BsonAppendObjv(interp, optsPtr, objc2, objv2);
1340
1341 cursor = mongoc_collection_find_with_opts( collectionPtr,
1342 filterPtr,
1343 optsPtr,
1344 readPrefsPtr);
1345
1346 if (cursor != NULL) {
1347 char buffer[80];
1348 if (Nsf_PointerAdd(interp, buffer, 80u, "mongoc_cursor_t", cursor) == TCL_OK) {
1349 Tcl_SetObjResult(interp, Tcl_NewStringObj(buffer, -1));
1350 } else {
1351 mongoc_cursor_destroy( cursor );
1352 result = TCL_ERROR;
1353 }
1354 } else {
1355 Tcl_ResetResult(interp);
1356 }
1357
1358 bson_destroy( filterPtr );
1359 bson_destroy( optsPtr );
1360
1361 return result;
1362 }
1363
1364 /*
1365 cmd cursor::next NsfMongoCursorNext {
1366 {-argName "cursor" -required 1 -type mongoc_cursor_t}
1367 }
1368 */
1369 static int
NsfMongoCursorNext(Tcl_Interp * interp,mongoc_cursor_t * cursor)1370 NsfMongoCursorNext(Tcl_Interp *interp, mongoc_cursor_t *cursor)
1371 {
1372 int result;
1373 const bson_t *nextPtr;
1374
1375 result = mongoc_cursor_next( cursor, &nextPtr );
1376 if (result == 1) {
1377 Tcl_SetObjResult(interp, BsonToList(interp, nextPtr, 0));
1378 }
1379
1380 return TCL_OK;
1381 }
1382
1383 /*
1384 cmd cursor::close NsfMongoCursorClose {
1385 {-argName "cursor" -required 1 -type mongoc_cursor_t -withObj 1}
1386 }
1387 */
1388 static int
NsfMongoCursorClose(Tcl_Interp * UNUSED (interp),mongoc_cursor_t * cursor,Tcl_Obj * cursorObj)1389 NsfMongoCursorClose(Tcl_Interp *UNUSED(interp), mongoc_cursor_t *cursor, Tcl_Obj *cursorObj)
1390 {
1391 mongoc_cursor_destroy( cursor );
1392 Nsf_PointerDelete(ObjStr(cursorObj), cursor, 0);
1393
1394 return TCL_OK;
1395 }
1396
1397
1398
1399 /***********************************************************************
1400 * GridFS interface
1401 ***********************************************************************/
1402
1403 /*
1404 cmd gridfs::close NsfMongoGridFSClose {
1405 {-argName "gfs" -required 1 -type mongoc_gridfs_t -withObj 1}
1406 }
1407 */
1408 static int
NsfMongoGridFSClose(Tcl_Interp * UNUSED (interp),mongoc_gridfs_t * gridfsPtr,Tcl_Obj * gridfsObj)1409 NsfMongoGridFSClose(Tcl_Interp *UNUSED(interp), mongoc_gridfs_t *gridfsPtr, Tcl_Obj *gridfsObj)
1410 {
1411 mongoc_gridfs_destroy(gridfsPtr);
1412 Nsf_PointerDelete(ObjStr(gridfsObj), gridfsPtr, 0);
1413
1414 return TCL_OK;
1415 }
1416
1417 /*
1418 cmd gridfs::open NsfMongoGridFSOpen {
1419 {-argName "conn" -required 1 -type mongoc_client_t}
1420 {-argName "dbname" -required 1}
1421 {-argName "prefix" -required 1}
1422 }
1423 */
1424
1425 static int
NsfMongoGridFSOpen(Tcl_Interp * interp,mongoc_client_t * clientPtr,const char * dbname,const char * prefix)1426 NsfMongoGridFSOpen(Tcl_Interp *interp, mongoc_client_t *clientPtr,
1427 const char *dbname, const char *prefix)
1428 {
1429 char buffer[80];
1430 int result = TCL_OK;
1431 bson_error_t bsonError;
1432 mongoc_gridfs_t *gfsPtr;
1433
1434 gfsPtr = mongoc_client_get_gridfs(clientPtr, dbname, prefix, &bsonError);
1435
1436 if (gfsPtr == NULL) {
1437 result = NsfPrintError(interp, "mongo::gridfs::open: error: %s", bsonError.message);
1438 }
1439
1440 if (Nsf_PointerAdd(interp, buffer, 80u, "mongoc_gridfs_t", gfsPtr) == TCL_OK) {
1441 Tcl_SetObjResult(interp, Tcl_NewStringObj(buffer, -1));
1442 } else {
1443 mongoc_gridfs_destroy(gfsPtr);
1444 result = TCL_ERROR;
1445 }
1446
1447 return result;
1448 }
1449
1450 /***********************************************************************
1451 * GridFile interface operating on GridFS
1452 ***********************************************************************/
1453
1454 #define MONGOC_GRIDFS_READ_CHUNK 4096*4
1455
1456
1457 /*
1458 cmd gridfile::create NsfMongoGridFileCreate {
1459 {-argName "-source" -required 1 -typeName "gridfilesource" -type "file|string"}
1460 {-argName "gfs" -required 1 -type mongoc_gridfs_t}
1461 {-argName "value" -required 1}
1462 {-argName "name" -required 1}
1463 {-argName "contenttype" -required 1}
1464 {-argName "-metadata" -required 0 -nrags 1 -type tclobj}
1465 }
1466 */
1467 static int
NsfMongoGridFileCreate(Tcl_Interp * interp,GridfilesourceIdx_t withSource,mongoc_gridfs_t * gridfsPtr,const char * value,const char * name,const char * contenttype,Tcl_Obj * withMetadata)1468 NsfMongoGridFileCreate(Tcl_Interp *interp,
1469 GridfilesourceIdx_t withSource,
1470 mongoc_gridfs_t *gridfsPtr,
1471 const char *value, const char *name,
1472 const char *contenttype,
1473 Tcl_Obj *withMetadata
1474 )
1475 {
1476 int result = TCL_OK;
1477 mongoc_gridfs_file_opt_t fileOpts ;
1478 mongoc_gridfs_file_t *gridFile;
1479 bson_t bsonMetaData, *bsonMetaDataPtr = &bsonMetaData;
1480
1481 memset(&fileOpts, 0, sizeof(fileOpts));
1482
1483 if (withSource == GridfilesourceNULL) {
1484 withSource = GridfilesourceFileIdx;
1485 }
1486
1487 if (withMetadata != NULL) {
1488 Tcl_Obj **objv;
1489 int objc;
1490
1491 result = Tcl_ListObjGetElements(interp, withMetadata, &objc, &objv);
1492 if (result != TCL_OK || ((objc % 3) != 0)) {
1493 return NsfPrintError(interp, "%s: must contain a multiple of 3 elements", ObjStr(withMetadata));
1494 }
1495 BsonAppendObjv(interp, bsonMetaDataPtr, objc, objv);
1496 fileOpts.metadata = bsonMetaDataPtr;
1497 }
1498
1499 fileOpts.filename = name;
1500 fileOpts.content_type = contenttype;
1501 /*
1502 const char *md5;
1503 const bson_t *aliases;
1504 uint32_t chunk_size;
1505 */
1506 gridFile = mongoc_gridfs_create_file(gridfsPtr, &fileOpts);
1507
1508 if (withSource == GridfilesourceFileIdx) {
1509 uint8_t buf[MONGOC_GRIDFS_READ_CHUNK];
1510 mongoc_iovec_t iov = { buf, 0 };
1511 int fd = open(value, O_RDONLY);
1512
1513 if (fd < 1) {
1514 mongoc_gridfs_file_destroy(gridFile);
1515 return NsfPrintError(interp, "nsf::gridfile::create: cannot open file '%s' for reading", value);
1516 }
1517
1518 for (;; ) {
1519 ssize_t n = read(fd, iov.iov_base, MONGOC_GRIDFS_READ_CHUNK);
1520
1521 if (n > 0) {
1522 iov.iov_len = (size_t)n;
1523 n = mongoc_gridfs_file_writev(gridFile, &iov, 1, 0);
1524 if ((size_t)n != iov.iov_len) {
1525 NsfLog(interp, NSF_LOG_WARN, "mongodb: write of %d bytes returned %d", iov.iov_len, n);
1526 }
1527 } else if (n == 0) {
1528 break;
1529 } else {
1530 result = TCL_ERROR;
1531 break;
1532 }
1533 }
1534 close(fd);
1535 } else {
1536 mongoc_iovec_t iov = { (char *)value, strlen(value) };
1537 mongoc_gridfs_file_writev(gridFile, &iov, 1, 0);
1538 }
1539 if (result == TCL_OK) {
1540 mongoc_gridfs_file_save(gridFile);
1541 }
1542
1543 mongoc_gridfs_file_destroy(gridFile);
1544
1545 Tcl_SetObjResult(interp, Tcl_NewIntObj(result == TCL_OK));
1546
1547 return result;
1548 }
1549
1550
1551 /*
1552 cmd "gridfile::delete" NsfMongoGridFileDelete {
1553 {-argName "gfs" -required 1 -type mongoc_gridfs_t}
1554 {-argName "query" -required 1 -type tclobj}
1555 }
1556 */
1557 static int
NsfMongoGridFileDelete(Tcl_Interp * interp,mongoc_gridfs_t * gridfsPtr,Tcl_Obj * queryObj)1558 NsfMongoGridFileDelete(Tcl_Interp *interp,
1559 mongoc_gridfs_t *gridfsPtr,
1560 Tcl_Obj *queryObj)
1561 {
1562 bson_t query, *queryPtr = &query;
1563 mongoc_cursor_t *files;
1564 const bson_t *nextPtr;
1565 bson_iter_t it;
1566 Tcl_Obj **objv;
1567 int objc, result;
1568 mongoc_read_prefs_t *readPrefsPtr = NULL; /* TODO: not handled */
1569
1570 result = Tcl_ListObjGetElements(interp, queryObj, &objc, &objv);
1571 if (result != TCL_OK || ((objc % 3) != 0)) {
1572 return NsfPrintError(interp, "%s: must contain a multiple of 3 elements", ObjStr(queryObj));
1573 }
1574
1575 BsonAppendObjv(interp, queryPtr, objc, objv);
1576 files = mongoc_collection_find_with_opts( mongoc_gridfs_get_files(gridfsPtr),
1577 queryPtr, NULL, readPrefsPtr);
1578 bson_destroy(queryPtr);
1579
1580 /*
1581 * Files should be a valid cursor even if the file doesn't exist.
1582 */
1583 if ( files == NULL ) {
1584 return NsfPrintError(interp, "gridfs::remove_file: invalid cursor for files");
1585 }
1586
1587 /*
1588 * Remove each file and it's chunks from files named filename.
1589 */
1590 while (mongoc_cursor_next(files, &nextPtr)) {
1591 bson_t bson, *bsonPtr = &bson;
1592 bson_error_t bsonError;
1593 bson_oid_t id;
1594
1595 bson_iter_init_find(&it, nextPtr, "_id");
1596 id = *bson_iter_oid(&it);
1597
1598 /*
1599 * Remove the file with the specified id.
1600 */
1601 bson_init(bsonPtr);
1602 bson_append_oid(bsonPtr, "_id", 3, &id);
1603 mongoc_collection_remove(mongoc_gridfs_get_files(gridfsPtr), 0, bsonPtr, NULL, &bsonError);
1604 bson_destroy(bsonPtr);
1605
1606 /*
1607 * Remove all chunks from the file with the specified id.
1608 */
1609 bson_init(bsonPtr);
1610 bson_append_oid(bsonPtr, "files_id", 8, &id);
1611 mongoc_collection_remove(mongoc_gridfs_get_chunks(gridfsPtr), 0, bsonPtr, NULL, &bsonError);
1612 bson_destroy(bsonPtr);
1613 }
1614
1615 mongoc_cursor_destroy(files);
1616 return TCL_OK;
1617 }
1618
1619 /*
1620 cmd gridfile::open NsfMongoGridFileOpen {
1621 {-argName "gfs" -required 1 -type mongoc_gridfs_t}
1622 {-argName "filter" -required 1 -type tclobj}
1623 }
1624 */
1625 static int
NsfMongoGridFileOpen(Tcl_Interp * interp,mongoc_gridfs_t * gridfsPtr,Tcl_Obj * filterObj)1626 NsfMongoGridFileOpen(Tcl_Interp *interp,
1627 mongoc_gridfs_t *gridfsPtr,
1628 Tcl_Obj *filterObj)
1629 {
1630 mongoc_gridfs_file_t* gridFilePtr;
1631 bson_error_t bsonError;
1632 bson_t filter, *filterPtr = &filter;
1633 int result, objc;
1634 Tcl_Obj **objv;
1635
1636 /*fprintf(stderr, "NsfMongoFilter: namespace %s withLimit %d withSkip %d\n",
1637 namespace, withLimit, withSkip);*/
1638
1639 result = Tcl_ListObjGetElements(interp, filterObj, &objc, &objv);
1640 if (result != TCL_OK || ((objc % 3) != 0)) {
1641 return NsfPrintError(interp, "%s: must contain a multiple of 3 elements", ObjStr(filterObj));
1642 }
1643
1644 BsonAppendObjv(interp, filterPtr, objc, objv);
1645
1646 gridFilePtr = mongoc_gridfs_find_one_with_opts(gridfsPtr, filterPtr, NULL, &bsonError);
1647
1648 if (gridFilePtr != NULL) {
1649 char buffer[80];
1650
1651 if (Nsf_PointerAdd(interp, buffer, 80u, "mongoc_gridfs_file_t", gridFilePtr) == TCL_OK) {
1652 Tcl_SetObjResult(interp, Tcl_NewStringObj(buffer, -1));
1653 } else {
1654 mongoc_gridfs_file_destroy(gridFilePtr);
1655 result = TCL_ERROR;
1656 }
1657 } else {
1658 Tcl_ResetResult(interp);
1659 }
1660
1661 bson_destroy(filterPtr);
1662 return result;
1663 }
1664
1665
1666 /***********************************************************************
1667 * GridFile interface
1668 *
1669 * Currently offsets and sizes are limited to 32bit integers, we should
1670 * relax this later.
1671 ***********************************************************************/
1672
1673 /*
1674 cmd gridfile::close NsfMongoGridFileClose {
1675 {-argName "gridfile" -required 1 -type mongoc_gridfs_file_t -withObj 1}
1676 }
1677 */
1678 static int
NsfMongoGridFileClose(Tcl_Interp * UNUSED (interp),mongoc_gridfs_file_t * gridFilePtr,Tcl_Obj * gridFileObj)1679 NsfMongoGridFileClose(Tcl_Interp *UNUSED(interp), mongoc_gridfs_file_t* gridFilePtr, Tcl_Obj *gridFileObj)
1680 {
1681 mongoc_gridfs_file_destroy(gridFilePtr);
1682 Nsf_PointerDelete(ObjStr(gridFileObj), gridFilePtr, 0);
1683
1684 return TCL_OK;
1685 }
1686
1687 /*
1688 cmd gridfile::get_contentlength NsfMongoGridFileGetContentlength {
1689 {-argName "gridfile" -required 1 -type mongoc_gridfs_file_t}
1690 }
1691 */
1692 static int
NsfMongoGridFileGetContentlength(Tcl_Interp * interp,mongoc_gridfs_file_t * gridFilePtr)1693 NsfMongoGridFileGetContentlength(Tcl_Interp *interp, mongoc_gridfs_file_t* gridFilePtr)
1694 {
1695 int64_t len;
1696
1697 len = mongoc_gridfs_file_get_length(gridFilePtr);
1698 Tcl_SetObjResult(interp, Tcl_NewLongObj(len));
1699
1700 return TCL_OK;
1701 }
1702
1703 /*
1704 cmd gridfile::get_contenttype NsfMongoGridFileGetContentType {
1705 {-argName "gridfile" -required 1 -type mongoc_gridfs_file_t}
1706 }
1707 */
1708 static int
NsfMongoGridFileGetContentType(Tcl_Interp * interp,mongoc_gridfs_file_t * gridFilePtr)1709 NsfMongoGridFileGetContentType(Tcl_Interp *interp, mongoc_gridfs_file_t* gridFilePtr)
1710 {
1711 Tcl_SetObjResult(interp, Tcl_NewStringObj(mongoc_gridfs_file_get_content_type(gridFilePtr), -1));
1712
1713 return TCL_OK;
1714 }
1715
1716
1717
1718 /*
1719 cmd gridfile::get_metadata NsfMongoGridFileGetMetaData {
1720 {-argName "gridfile" -required 1 -type mongoc_gridfs_file_t}
1721 }
1722 */
1723 static int
NsfMongoGridFileGetMetaData(Tcl_Interp * interp,mongoc_gridfs_file_t * gridFilePtr)1724 NsfMongoGridFileGetMetaData(Tcl_Interp *interp, mongoc_gridfs_file_t* gridFilePtr)
1725 {
1726 const bson_t *metaDataPtr = mongoc_gridfs_file_get_metadata(gridFilePtr);
1727
1728 if (metaDataPtr != NULL) {
1729 Tcl_SetObjResult(interp, BsonToList(interp, metaDataPtr, 0));
1730 }
1731 return TCL_OK;
1732 }
1733
1734 /*
1735 cmd gridfile::read NsfMongoGridFileRead {
1736 {-argName "gridfile" -required 1 -type mongoc_gridfs_file_t}
1737 {-argName "size" -required 1 -type int}
1738 }
1739 */
1740 static int
NsfMongoGridFileRead(Tcl_Interp * interp,mongoc_gridfs_file_t * gridFilePtr,int size)1741 NsfMongoGridFileRead(Tcl_Interp *interp, mongoc_gridfs_file_t *gridFilePtr, int size)
1742 {
1743 ssize_t readSize;
1744 Tcl_Obj *resultObj = Tcl_NewByteArrayObj(NULL, size);
1745 mongoc_iovec_t iov = { NULL, (size_t)size };
1746
1747 assert(size > 0);
1748
1749 iov.iov_base = Tcl_SetByteArrayLength(resultObj, size);
1750
1751 readSize = mongoc_gridfs_file_readv(gridFilePtr, &iov, 1,
1752 0 /* min_bytes */,
1753 0 /* timeout_msec */);
1754 /*fprintf(stderr, "NsfMongoGridFileRead want %d got %d\n", size, readSize);*/
1755 Tcl_SetByteArrayLength(resultObj, (int)readSize);
1756 Tcl_SetObjResult(interp, resultObj);
1757
1758 return TCL_OK;
1759 }
1760
1761 /*
1762 cmd "gridfile::seek" NsfMongoGridFileSeek {
1763 {-argName "gridfile" -required 1 -type mongoc_gridfs_file_t}
1764 {-argName "offset" -required 1 -type int32}
1765 }
1766 */
1767 static int
NsfMongoGridFileSeek(Tcl_Interp * UNUSED (interp),mongoc_gridfs_file_t * gridFilePtr,int offset)1768 NsfMongoGridFileSeek(Tcl_Interp *UNUSED(interp), mongoc_gridfs_file_t *gridFilePtr, int offset)
1769 {
1770 int result;
1771
1772 /*
1773 * TODO: whence SEEK_SET, SEEK_CUR or SEEK_END; implementation of SEEK_END looks incorrect
1774 */
1775 result = mongoc_gridfs_file_seek(gridFilePtr, offset, SEEK_SET);
1776
1777 return result < 0 ? TCL_ERROR : TCL_OK;
1778 }
1779
1780 /***********************************************************************
1781 * Finally, provide the necessary Tcl package interface.
1782 ***********************************************************************/
1783
1784 static void
Nsfmongo_ThreadExit(ClientData UNUSED (clientData))1785 Nsfmongo_ThreadExit(ClientData UNUSED(clientData))
1786 {
1787 /*
1788 * The exit might happen at a time, when Tcl is already shut down.
1789 * We can't reliably call NsfLog.
1790 */
1791
1792 fprintf(stderr, "+++ Nsfmongo_ThreadExit\n");
1793
1794 #if defined(USE_CLIENT_POOL)
1795 NsfMutexLock(&poolMutex);
1796 mongoClientPoolRefCount --;
1797 if (mongoClientPool != NULL) {
1798 /*fprintf(stderr, "========= Nsfmongo_ThreadExit mongoClientPoolRefCount %d\n", mongoClientPoolRefCount);*/
1799 if (mongoClientPoolRefCount < 1) {
1800 mongoc_client_pool_destroy(mongoClientPool);
1801 mongoClientPool = NULL;
1802 mongoc_uri_destroy(mongoUri);
1803 mongoUri = NULL;
1804 }
1805 }
1806 NsfMutexUnlock(&poolMutex);
1807 #endif
1808 }
1809
1810 static void
Nsfmongo_Exit(ClientData clientData)1811 Nsfmongo_Exit(ClientData clientData)
1812 {
1813 /*
1814 * The exit might happen at a time, when Tcl is already shut down.
1815 * We can't reliably call NsfLog.
1816 *
1817 * Tcl_Interp *interp = (Tcl_Interp *)clientData;
1818 * NsfLog(interp,NSF_LOG_NOTICE, "Nsfmongo Exit");
1819 */
1820
1821 fprintf(stderr, "+++ Nsfmongo_Exit\n");
1822
1823 #if defined(TCL_THREADS)
1824 Tcl_DeleteThreadExitHandler(Nsfmongo_ThreadExit, clientData);
1825 #endif
1826 Tcl_Release(clientData);
1827
1828 /*
1829 * Release the state of mongo-c-driver explicitly.
1830 */
1831 mongoc_cleanup();
1832 }
1833
1834
1835 extern int
Nsfmongo_Init(Tcl_Interp * interp)1836 Nsfmongo_Init(Tcl_Interp * interp)
1837 {
1838 int i;
1839 static NsfMutex initMutex = 0;
1840
1841 #ifdef USE_TCL_STUBS
1842 if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
1843 return TCL_ERROR;
1844 }
1845
1846 # ifdef USE_NSF_STUBS
1847 if (Nsf_InitStubs(interp, "2.0", 0) == NULL) {
1848 return TCL_ERROR;
1849 }
1850 # endif
1851
1852 #else
1853 if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
1854 return TCL_ERROR;
1855 }
1856 #endif
1857 Tcl_PkgProvide(interp, "nsf::mongo", PACKAGE_VERSION);
1858
1859 #ifdef PACKAGE_REQUIRE_FROM_SLAVE_INTERP_WORKS_NOW
1860 if (Tcl_PkgRequire(interp, "nsf", PACKAGE_VERSION, 0) == NULL) {
1861 return TCL_ERROR;
1862 }
1863 #endif
1864
1865 Tcl_Preserve(interp);
1866 #if defined(TCL_THREADS)
1867 Tcl_CreateThreadExitHandler(Nsfmongo_ThreadExit, interp);
1868 #endif
1869 Tcl_CreateExitHandler(Nsfmongo_Exit, interp);
1870
1871 #if defined(USE_CLIENT_POOL)
1872 NsfMutexLock(&poolMutex);
1873 mongoClientPoolRefCount ++;
1874 NsfMutexUnlock(&poolMutex);
1875 #endif
1876
1877 /*
1878 * Register global mongo Tcl_Objs once.
1879 */
1880 NsfMutexLock(&initMutex);
1881 if (NsfMongoGlobalObjs == NULL) {
1882 NsfMongoGlobalObjs = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj*)*nr_elements(NsfMongoGlobalStrings));
1883
1884 for (i = 0; i < nr_elements(NsfMongoGlobalStrings); i++) {
1885 NsfMongoGlobalObjs[i] = Tcl_NewStringObj(NsfMongoGlobalStrings[i], -1);
1886 Tcl_IncrRefCount(NsfMongoGlobalObjs[i]);
1887 }
1888
1889 /*
1890 * Initializing state of mongo-c-driver explicitly.
1891 */
1892 mongoc_init();
1893 }
1894 NsfMutexUnlock(&initMutex);
1895
1896 Nsf_EnumerationTypeRegister(interp, enumeratorConverterEntries);
1897 Nsf_CmdDefinitionRegister(interp, method_definitions);
1898
1899 /*
1900 * Register the pointer converter.
1901 */
1902 Nsf_PointerTypeRegister(interp, "mongoc_client_t", &mongoClientCount);
1903 Nsf_PointerTypeRegister(interp, "mongoc_collection_t", &mongoCollectionCount);
1904 Nsf_PointerTypeRegister(interp, "mongoc_cursor_t", &mongoCursorCount);
1905 Nsf_PointerTypeRegister(interp, "mongoc_gridfs_file_t", &gridfileCount);
1906 Nsf_PointerTypeRegister(interp, "mongoc_gridfs_t", &gridfsCount);
1907
1908 for (i=0; i < nr_elements(method_command_namespace_names); i++) {
1909 Tcl_CreateNamespace(interp, method_command_namespace_names[i], 0, (Tcl_NamespaceDeleteProc *)NULL);
1910 }
1911
1912 /*
1913 * Create all method commands (will use the namespaces above)
1914 */
1915 for (i = 0; i < nr_elements(method_definitions)-1; i++) {
1916 Tcl_CreateObjCommand(interp, method_definitions[i].methodName, method_definitions[i].proc, 0, 0);
1917 }
1918
1919 Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
1920
1921 return TCL_OK;
1922 }
1923
1924 extern int
Nsfmongo_SafeInit(Tcl_Interp * interp)1925 Nsfmongo_SafeInit( Tcl_Interp *interp) {
1926 return Nsfmongo_Init(interp);
1927 }
1928
1929 /*
1930 * Local Variables:
1931 * mode: c
1932 * c-basic-offset: 2
1933 * fill-column: 78
1934 * indent-tabs-mode: nil
1935 * End:
1936 */
1937