├── Couchbase.API.pas ├── Couchbase.pas ├── License.txt ├── README.md └── Tests ├── Bin ├── example.json ├── libcouchbase.dll └── query.json ├── CouchbaseTests.dpr ├── CouchbaseTests.dproj ├── CouchbaseTests.res └── TestCouchbase.pas /Couchbase.API.pas: -------------------------------------------------------------------------------- 1 | unit Couchbase.API; 2 | 3 | { Implementation of the Couchbase library interface } 4 | 5 | interface 6 | 7 | { Couchbase } 8 | 9 | const 10 | LCB_CONFIG_MCD_PORT = 11210; 11 | LCB_CONFIG_MCD_SSL_PORT = 11207; 12 | LCB_CONFIG_HTTP_PORT = 8091; 13 | LCB_CONFIG_HTTP_SSL_PORT = 18091; 14 | LCB_CONFIG_MCCOMPAT_PORT = 11211; 15 | 16 | LCB_TYPE_BUCKET = 0; 17 | LCB_TYPE_CLUSTER = 1; 18 | 19 | LCB_CONFIG_TRANSPORT_LIST_END = 0; 20 | LCB_CONFIG_TRANSPORT_HTTP = 1; 21 | LCB_CONFIG_TRANSPORT_CCCP = LCB_CONFIG_TRANSPORT_HTTP + 1; 22 | LCB_CONFIG_TRANSPORT_MAX = LCB_CONFIG_TRANSPORT_CCCP + 1; 23 | 24 | LCB_RESP_F_FINAL = $01; 25 | LCB_RESP_F_CLIENTGEN = $02; 26 | LCB_RESP_F_NMVGEN = $04; 27 | LCB_RESP_F_EXTDATA = $08; 28 | LCB_RESP_F_SDSINGLE = $010; 29 | 30 | LCB_CALLBACK_DEFAULT = 0; 31 | LCB_CALLBACK_GET = LCB_CALLBACK_DEFAULT + 1; 32 | LCB_CALLBACK_STORE = LCB_CALLBACK_GET + 1; 33 | LCB_CALLBACK_COUNTER = LCB_CALLBACK_STORE + 1; 34 | LCB_CALLBACK_TOUCH = LCB_CALLBACK_COUNTER + 1; 35 | LCB_CALLBACK_REMOVE = LCB_CALLBACK_TOUCH + 1; 36 | LCB_CALLBACK_UNLOCK = LCB_CALLBACK_REMOVE + 1; 37 | LCB_CALLBACK_STATS = LCB_CALLBACK_UNLOCK + 1; 38 | LCB_CALLBACK_VERSIONS = LCB_CALLBACK_STATS + 1; 39 | LCB_CALLBACK_VERBOSITY = LCB_CALLBACK_VERSIONS + 1; 40 | LCB_CALLBACK_FLUSH = LCB_CALLBACK_VERBOSITY + 1; 41 | LCB_CALLBACK_OBSERVE = LCB_CALLBACK_FLUSH + 1; 42 | LCB_CALLBACK_GETREPLICA = LCB_CALLBACK_OBSERVE + 1; 43 | LCB_CALLBACK_ENDURE = LCB_CALLBACK_GETREPLICA + 1; 44 | LCB_CALLBACK_HTTP = LCB_CALLBACK_ENDURE + 1; 45 | LCB_CALLBACK_CBFLUSH = LCB_CALLBACK_HTTP + 1; 46 | LCB_CALLBACK_OBSEQNO = LCB_CALLBACK_CBFLUSH + 1; 47 | LCB_CALLBACK_STOREDUR = LCB_CALLBACK_OBSEQNO + 1; 48 | LCB_CALLBACK_SDLOOKUP = LCB_CALLBACK_STOREDUR + 1; 49 | LCB_CALLBACK_SDMUTATE = LCB_CALLBACK_SDLOOKUP + 1; 50 | LCB_CALLBACK__MAX = LCB_CALLBACK_SDMUTATE + 1; 51 | 52 | LCB_CALLBACK_VIEWQUERY = -1; 53 | LCB_CALLBACK_N1QL = -2; 54 | LCB_CALLBACK_IXMGMT = -3; 55 | LCB_CMDGET_F_CLEAREXP = 1 shl 16; 56 | 57 | LCB_DURABILITY_MODE_DEFAULT = 0; 58 | LCB_DURABILITY_MODE_CAS = LCB_DURABILITY_MODE_DEFAULT + 1; 59 | LCB_DURABILITY_MODE_SEQNO = LCB_DURABILITY_MODE_CAS + 1; 60 | 61 | LCB_CMDENDURE_F_MUTATION_TOKEN = 1 shl 16; 62 | LCB_DURABILITY_VALIDATE_CAPMAX = 1 shl 1; 63 | LCB_CMDOBSERVE_F_MASTER_ONLY = 1 shl 16; 64 | 65 | LCB_OBSERVE_FOUND = $00; 66 | LCB_OBSERVE_PERSISTED = $01; 67 | LCB_OBSERVE_NOT_FOUND = $80; 68 | LCB_OBSERVE_LOGICALLY_DELETED = $81; 69 | LCB_OBSERVE_MAX = $82; 70 | 71 | LCB_CMDSTATS_F_KV = 1 shl 16; 72 | 73 | LCB_CMDHTTP_F_STREAM = 1 shl 16; 74 | LCB_CMDHTTP_F_CASTMO = 1 shl 17; 75 | LCB_CMDHTTP_F_NOUPASS = 1 shl 18; 76 | 77 | LCB_DATATYPE_JSON = $01; 78 | 79 | LCB_VALUE_RAW = $00; 80 | LCB_VALUE_F_JSON = $01; 81 | LCB_VALUE_F_SNAPPYCOMP = LCB_VALUE_F_JSON + 1; 82 | 83 | LCB_GETNODE_UNAVAILABLE = 'invalid_host:0'; 84 | 85 | LCB_TIMEUNIT_NSEC = 0; 86 | LCB_TIMEUNIT_USEC = 1; 87 | LCB_TIMEUNIT_MSEC = 2; 88 | LCB_TIMEUNIT_SEC = 3 ; 89 | 90 | LCB_VERSION_STRING = 'unknown'; 91 | LCB_VERSION = $000000; 92 | LCB_VERSION_CHANGESET = '$deadbeef'; 93 | LCB_SUPPORTS_SSL = 1; 94 | LCB_SUPPORTS_SNAPPY = 2; 95 | 96 | LCB_DUMP_VBCONFIG = $01; 97 | LCB_DUMP_PKTINFO = $02; 98 | LCB_DUMP_BUFINFO = $04; 99 | LCB_DUMP_ALL = $FF; 100 | 101 | { Operations } 102 | LCB_UPSERT = 0; 103 | LCB_ADD = 1; 104 | LCB_REPLACE = 2; 105 | LCB_SET = 3; 106 | LCB_APPEND = 4; 107 | LCB_PREPEND = 5; 108 | 109 | { Wait flags } 110 | LCB_WAIT_DEFAULT = 0; 111 | LCB_WAIT_NOCHECK = 1; 112 | 113 | { KV buffer types } 114 | LCB_KV_COPY = 0; 115 | LCB_KV_CONTIG = 1; 116 | LCB_KV_IOV = 2; 117 | LCB_KV_VBID = 3; 118 | LCB_KV_IOVCOPY = 4; 119 | 120 | { Error codes } 121 | LCB_SUCCESS = $00; 122 | LCB_AUTH_CONTINUE = $01; 123 | LCB_AUTH_ERROR = $02; 124 | LCB_DELTA_BADVAL = $03; 125 | LCB_E2BIG = $04; 126 | LCB_EBUSY = $05; 127 | LCB_EINTERNAL = $06; 128 | LCB_EINVAL = $07; 129 | LCB_ENOMEM = $08; 130 | LCB_ERANGE = $09; 131 | LCB_OTHER_ERROR = $0A; 132 | LCB_ETMPFAIL = $0B; 133 | LCB_KEY_EEXISTS = $0C; 134 | LCB_KEY_ENOENT = $0D; 135 | LCB_DLOPEN_FAILED = $0E; 136 | LCB_DLSYM_FAILED = $0F; 137 | LCB_NETWORK_ERROR = $10; 138 | LCB_NOT_MY_VBUCKET = $11; 139 | LCB_NOT_STORED = $12; 140 | LCB_NOT_SUPPORTED = $13; 141 | LCB_UNKNOWN_COMMAND = $14; 142 | LCB_UNKNOWN_HOST = $15; 143 | LCB_PROTOCOL_ERROR = $16; 144 | LCB_ETIMEDOUT = $17; 145 | LCB_CONNECT_ERROR = $18; 146 | LCB_BUCKET_ENOENT = $19; 147 | LCB_CLIENT_ENOMEM = $1A; 148 | LCB_CLIENT_ENOCONF = $1B; 149 | LCB_EBADHANDLE = $1C; 150 | LCB_SERVER_BUG = $1D; 151 | LCB_PLUGIN_VERSION_MISMATCH = $1E; 152 | LCB_INVALID_HOST_FORMAT = $1F; 153 | LCB_INVALID_CHAR = $20; 154 | LCB_DURABILITY_ETOOMANY = $21; 155 | LCB_DUPLICATE_COMMANDS = $22; 156 | LCB_NO_MATCHING_SERVER = $23; 157 | LCB_BAD_ENVIRONMENT = $24; 158 | LCB_BUSY = $25; 159 | LCB_INVALID_USERNAME = $26; 160 | LCB_CONFIG_CACHE_INVALID = $27; 161 | LCB_SASLMECH_UNAVAILABLE = $28; 162 | LCB_TOO_MANY_REDIRECTS = $29; 163 | LCB_MAP_CHANGED = $2A; 164 | LCB_INCOMPLETE_PACKET = $2B; 165 | LCB_ECONNREFUSED = $2C; 166 | LCB_ESOCKSHUTDOWN = $2D; 167 | LCB_ECONNRESET = $2E; 168 | LCB_ECANTGETPORT = $2F; 169 | LCB_EFDLIMITREACHED = $30; 170 | LCB_ENETUNREACH = $31; 171 | LCB_ECTL_UNKNOWN = $32; 172 | LCB_ECTL_UNSUPPMODE = $33; 173 | LCB_ECTL_BADARG = $34; 174 | LCB_EMPTY_KEY = $35; 175 | LCB_SSL_ERROR = $36; 176 | LCB_SSL_CANTVERIFY = $37; 177 | LCB_SCHEDFAIL_INTERNAL = $38; 178 | LCB_CLIENT_FEATURE_UNAVAILABLE = $39; 179 | LCB_OPTIONS_CONFLICT = $3A; 180 | LCB_HTTP_ERROR = $3B; 181 | LCB_DURABILITY_NO_MUTATION_TOKENS = $3C; 182 | LCB_UNKNOWN_MEMCACHED_ERROR = $3D; 183 | LCB_MUTATION_LOST = $3E; 184 | LCB_SUBDOC_PATH_ENOENT = $3F; 185 | LCB_SUBDOC_PATH_MISMATCH = $40; 186 | LCB_SUBDOC_PATH_EINVAL = $41; 187 | LCB_SUBDOC_PATH_E2BIG = $42; 188 | LCB_SUBDOC_DOC_E2DEEP = $43; 189 | LCB_SUBDOC_VALUE_CANTINSERT = $44; 190 | LCB_SUBDOC_DOC_NOTJSON = $45; 191 | LCB_SUBDOC_NUM_ERANGE = $46; 192 | LCB_SUBDOC_BAD_DELTA = $47; 193 | LCB_SUBDOC_PATH_EEXISTS = $48; 194 | LCB_SUBDOC_MULTI_FAILURE = $49; 195 | LCB_SUBDOC_VALUE_E2DEEP = $4A; 196 | LCB_EINVAL_MCD = $4B; 197 | LCB_EMPTY_PATH = $4C; 198 | LCB_UNKNOWN_SDCMD = $4D; 199 | LCB_ENO_COMMANDS = $4E; 200 | LCB_QUERY_ERROR = $4F; 201 | 202 | { N1QL } 203 | 204 | const 205 | LCB_N1P_CONSISTENCY_NONE = 0; 206 | LCB_N1P_CONSISTENCY_RYOW = 1; 207 | LCB_N1P_CONSISTENCY_REQUEST = 2; 208 | LCB_N1P_CONSISTENCY_STATEMENT = 3; 209 | 210 | LCB_CMDN1QL_F_PREPCACHE = 1 shl 16; 211 | LCB_CMDN1QL_F_JSONQUERY = 1 shl 17; 212 | 213 | LCB_N1P_QUERY_STATEMENT = 1; 214 | LCB_N1P_QUERY_PREPARED = 2; 215 | 216 | type 217 | lcb_t = Pointer{plcb_st}; 218 | plcb_t = ^lcb_t; 219 | lcb_http_request_t = Pointer{plcb_http_request_st}; 220 | plcb_http_request_t = ^lcb_http_request_t; 221 | 222 | Lcb_type_t = Integer; 223 | 224 | lcb_create_st0 = record 225 | host: PAnsiChar; 226 | user: PAnsiChar; 227 | passwd: PAnsiChar; 228 | bucket: PAnsiChar; 229 | io: Pointer{plcb_io_opt_st}; 230 | end; 231 | 232 | lcb_create_st1 = record 233 | host: PAnsiChar; 234 | user: PAnsiChar; 235 | passwd: PAnsiChar; 236 | bucket: PAnsiChar; 237 | io: Pointer{plcb_io_opt_st}; 238 | &type: lcb_type_t; 239 | end; 240 | 241 | lcb_create_st2 = record 242 | host: PAnsiChar; 243 | user: PAnsiChar; 244 | passwd: PAnsiChar; 245 | bucket: PAnsiChar; 246 | io: Pointer{plcb_io_opt_st}; 247 | &type: lcb_type_t; 248 | mchosts: PAnsiChar; 249 | transports: Pointer{plcb_config_transport_t}; 250 | end; 251 | 252 | lcb_create_st3 = record 253 | connstr: PAnsiChar; 254 | username: PAnsiChar; 255 | passwd: PAnsiChar; 256 | _pad_bucket: Pointer; 257 | io: Pointer{plcb_io_opt_st}; 258 | &type: Lcb_type_t; 259 | end; 260 | plcb_create_st3 = ^lcb_create_st3; 261 | 262 | lcb_create_st = record 263 | version: Integer; 264 | case Integer of 265 | 0: (v0: lcb_create_st0); 266 | 1: (v1: lcb_create_st1); 267 | 2: (v2: lcb_create_st2); 268 | 3: (v3: lcb_create_st3); 269 | end; 270 | plcb_create_st = ^lcb_create_st; 271 | 272 | Lcb_error_t = Integer; 273 | plcb_error_t = ^lcb_error_t; 274 | 275 | lcb_error = NativeInt; 276 | 277 | size_t = NativeUInt; 278 | ssize_t = NativeInt; 279 | time_t = NativeInt; 280 | 281 | lcb_int64_t = int64; 282 | lcb_int32_t = int32; 283 | lcb_size_t = size_t; 284 | lcb_ssize_t = ssize_t; 285 | lcb_vbucket_t = uint16; 286 | lcb_uint8_t = uint8; 287 | lcb_uint16_t = uint16; 288 | lcb_uint32_t = uint32; 289 | lcb_cas_t = uint64; 290 | lcb_uint64_t = uint64; 291 | lcb_time_t = time_t; 292 | 293 | lcb_S64 = lcb_int64_t; 294 | lcb_U64 = lcb_uint64_t; 295 | lcb_U32 = lcb_uint32_t; 296 | lcb_S32 = lcb_int32_t; 297 | lcb_U16 = lcb_uint16_t; 298 | lcb_U8 = lcb_uint8_t; 299 | lcb_SECS = lcb_time_t; 300 | plcb_U16 = ^lcb_U16; 301 | plcb_U32 = ^lcb_U32; 302 | 303 | lcb_datatype_t = lcb_U8; 304 | lcb_size = size_t; 305 | lcb_storage_t = Integer; 306 | lcb_cas = lcb_cas_t; 307 | 308 | lcb_RESPBASE = record 309 | cookie: Pointer; 310 | key: Pointer; 311 | nkey: lcb_size; 312 | cas: lcb_cas; 313 | rc: lcb_error_t; 314 | version: lcb_U16; 315 | rflags: lcb_U16; 316 | end; 317 | plcb_RESPBASE = ^lcb_RESPBASE; 318 | 319 | lcb_RESPSERVERFIELDS = record 320 | server: PAnsiChar; 321 | end; 322 | 323 | lcb_RESPSERVERBASE = packed record 324 | respbase: lcb_RESPBASE; 325 | respserverfields: lcb_RESPSERVERFIELDS; 326 | end; 327 | plcb_RESPSERVERBASE = ^lcb_RESPSERVERBASE; 328 | 329 | Lcb_timeunit_t = Integer; 330 | 331 | lcb_KVBUFTYPE = Integer; 332 | 333 | lcb_CONTIGBUF = record 334 | bytes: Pointer; 335 | nbytes: lcb_size_t; 336 | end; 337 | 338 | lcb_KEYBUF = record 339 | &type: lcb_KVBUFTYPE; 340 | contig: lcb_CONTIGBUF; 341 | end; 342 | plcb_KEYBUF = ^lcb_KEYBUF; 343 | 344 | lcb_CMDBASE = record 345 | cmdflags: lcb_U32; 346 | exptime: lcb_U32; 347 | cas: lcb_U64; 348 | key: lcb_KEYBUF; 349 | _hashkey: lcb_KEYBUF; 350 | end; 351 | plcb_CMDBASE = ^lcb_CMDBASE; 352 | 353 | lcb_CMDGET = record 354 | cmdbase: lcb_CMDBASE; 355 | lock: Integer; 356 | end; 357 | plcb_CMDGET = ^lcb_CMDGET; 358 | 359 | lcb_RESPSTORE = record 360 | respbase: lcb_RESPBASE; 361 | op: lcb_storage_t; 362 | end; 363 | plcb_RESPSTORE = ^lcb_RESPSTORE; 364 | 365 | lcb_RESPGET = record 366 | respbase: lcb_RESPBASE; 367 | value: Pointer; 368 | nvalue: lcb_size; 369 | bufh: Pointer; 370 | datatype: lcb_datatype_t; 371 | itmflags: lcb_U32; 372 | end; 373 | plcb_RESPGET = ^lcb_RESPGET; 374 | 375 | lcb_RESPCOUNTER = record 376 | respbase: lcb_RESPBASE; 377 | value: lcb_U64; 378 | end; 379 | plcb_RESPCOUNTER = ^lcb_RESPCOUNTER; 380 | 381 | lcb_RESPFLUSH = record 382 | respserverbase: lcb_RESPSERVERBASE; 383 | end; 384 | plcb_RESPFLUSH = ^lcb_RESPFLUSH; 385 | 386 | lcb_RESPSTATS = record 387 | respserverbase: lcb_RESPSERVERBASE; 388 | value: PAnsiChar; 389 | nvalue: lcb_SIZE; 390 | end; 391 | plcb_RESPSTATS = ^lcb_RESPSTATS; 392 | 393 | lcb_replica_t = ( 394 | LCB_REPLICA_FIRST = 0, 395 | LCB_REPLICA_ALL = 1, 396 | LCB_REPLICA_SELECT = 2); 397 | 398 | lcb_CMDGETREPLICA = record 399 | cmdbase: lcb_CMDBASE; 400 | strategy: lcb_replica_t; 401 | index: Integer; 402 | end; 403 | plcb_CMDGETREPLICA = ^lcb_CMDGETREPLICA; 404 | 405 | lcb_FRAGBUF = record 406 | iov: Pointer{lcb_IOV}; 407 | niov: UInt32; 408 | total_length: UInt32; 409 | end; 410 | 411 | lcb_VALBUF = record 412 | vtype: lcb_KVBUFTYPE; 413 | case Integer of 414 | 0: (contig: lcb_CONTIGBUF); 415 | 1: (multi: lcb_FRAGBUF); 416 | end; 417 | 418 | lcb_CMDSTORE = record 419 | cmdbase: lcb_CMDBASE; 420 | value: lcb_VALBUF; 421 | flags: lcb_U32; 422 | datatype: lcb_datatype_t; 423 | operation: lcb_storage_t; 424 | end; 425 | plcb_CMDSTORE = ^lcb_CMDSTORE; 426 | 427 | lcb_CMDREMOVE = record 428 | cmdbase: lcb_CMDBASE; 429 | end; 430 | plcb_CMDREMOVE = ^lcb_CMDREMOVE; 431 | 432 | lcb_DURABILITYOPTSv0 = record 433 | timeout: lcb_U32; 434 | interval: lcb_U32; 435 | persist_to: lcb_U16; 436 | replicate_to: lcb_U16; 437 | check_delete: lcb_U8; 438 | cap_max: lcb_U8; 439 | pollopts: lcb_U8; 440 | end; 441 | 442 | lcb_durability_opts_t = record 443 | version: Integer; 444 | case Integer of 445 | 0: (v0: lcb_DURABILITYOPTSv0); 446 | end; 447 | plcb_durability_opts_t = ^lcb_durability_opts_t; 448 | 449 | lcb_CMDSTOREDUR = record 450 | cmdbase: lcb_CMDBASE; 451 | value: lcb_VALBUF; 452 | flags: lcb_U32; 453 | datatype: lcb_datatype_t; 454 | operation: lcb_storage_t; 455 | persist_to: Byte; 456 | replicate_to: Byte; 457 | end; 458 | plcb_CMDSTOREDUR = ^lcb_CMDSTOREDUR; 459 | 460 | plcb_MULTICMD_CTX_st = ^TLcb_MULTICMD_CTX_st; 461 | Pplcb_MULTICMD_CTX_st = ^plcb_MULTICMD_CTX_st; 462 | TLcb_MULTICMD_CTX_st = record 463 | addcmd: function(ctx: plcb_MULTICMD_CTX_st; const cmd: plcb_CMDBASE): Lcb_error_t; cdecl; 464 | done: function(ctx: plcb_MULTICMD_CTX_st; const cookie: Pointer): Lcb_error_t; cdecl; 465 | fail: procedure(ctx: plcb_MULTICMD_CTX_st); cdecl; 466 | end; 467 | Tlcb_MULTICMD_CTX = TLcb_MULTICMD_CTX_st; 468 | plcb_MULTICMD_CTX = ^TLcb_MULTICMD_CTX; 469 | 470 | lcb_CMDOBSEQNO = record 471 | cmdbase: lcb_CMDBASE; 472 | server_index: lcb_U16; 473 | vbid: lcb_U16; 474 | uuid: lcb_U64; 475 | end; 476 | plcb_CMDOBSEQNO = ^lcb_CMDOBSEQNO; 477 | 478 | lcb_MUTATION_TOKEN = record 479 | uuid_: lcb_U64; 480 | seqno_: lcb_U64; 481 | vbid_: lcb_U16; 482 | end; 483 | plcb_MUTATION_TOKEN = ^lcb_MUTATION_TOKEN; 484 | 485 | lcb_CMDCOUNTER = record 486 | cmdbase: lcb_CMDBASE; 487 | delta: lcb_int64_t; 488 | initial: lcb_U64; 489 | create: Integer; 490 | end; 491 | plcb_CMDCOUNTER = ^lcb_CMDCOUNTER; 492 | 493 | lcb_CMDUNLOCK = record 494 | cmdbase: lcb_CMDBASE; 495 | end; 496 | plcb_CMDUNLOCK = ^lcb_CMDUNLOCK; 497 | 498 | lcb_CMDTOUCH = record 499 | cmdbase: lcb_CMDBASE; 500 | end; 501 | plcb_CMDTOUCH = ^lcb_CMDTOUCH; 502 | 503 | lcb_CMDSTATS = record 504 | cmdbase: lcb_CMDBASE; 505 | end; 506 | plcb_CMDSTATS = ^lcb_CMDSTATS; 507 | 508 | lcb_verbosity_level_t = ( 509 | LCB_VERBOSITY_DETAIL = 0, 510 | LCB_VERBOSITY_DEBUG = 1, 511 | LCB_VERBOSITY_INFO = 2, 512 | LCB_VERBOSITY_WARNING = 3); 513 | 514 | lcb_CMDVERBOSITY = record 515 | cmdbase: lcb_CMDBASE; 516 | server: PAnsiChar; 517 | level: lcb_verbosity_level_t; 518 | end; 519 | plcb_CMDVERBOSITY = ^lcb_CMDVERBOSITY; 520 | 521 | lcb_CMDCBFLUSH = record 522 | cmdbase: lcb_CMDBASE; 523 | end; 524 | plcb_CMDCBFLUSH = ^lcb_CMDCBFLUSH; 525 | 526 | lcb_CMDFLUSH = record 527 | cmdbase: lcb_CMDBASE; 528 | end; 529 | plcb_CMDFLUSH = ^lcb_CMDFLUSH; 530 | 531 | lcb_http_type_t = ( 532 | LCB_HTTP_TYPE_VIEW = 0, 533 | LCB_HTTP_TYPE_MANAGEMENT = 1, 534 | LCB_HTTP_TYPE_RAW = 2, 535 | LCB_HTTP_TYPE_N1QL = 3, 536 | LCB_HTTP_TYPE_FTS = 4, 537 | LCB_HTTP_TYPE_MAX = LCB_HTTP_TYPE_FTS + 1); 538 | 539 | lcb_http_method_t = ( 540 | LCB_HTTP_METHOD_GET = 0, 541 | LCB_HTTP_METHOD_POST = 1, 542 | LCB_HTTP_METHOD_PUT = 2, 543 | LCB_HTTP_METHOD_DELETE = 3, 544 | LCB_HTTP_METHOD_MAX = 4); 545 | 546 | lcb_CMDHTTP = record 547 | cmdbase: lcb_CMDBASE; 548 | &type: lcb_http_type_t; 549 | method: lcb_http_method_t; 550 | body: PAnsiChar; 551 | nbody: lcb_size; 552 | reqhandle: plcb_http_request_t; 553 | content_type: PAnsiChar; 554 | username: PAnsiChar; 555 | password: PAnsiChar; 556 | host: PAnsiChar; 557 | end; 558 | plcb_CMDHTTP = ^lcb_CMDHTTP; 559 | 560 | lcb_GETNODETYPE = ( 561 | LCB_NODE_HTCONFIG = $01, 562 | LCB_NODE_DATA = $02, 563 | LCB_NODE_VIEWS = $04, 564 | LCB_NODE_CONNECTED = $08, 565 | LCB_NODE_NEVERNULL = $10, 566 | LCB_NODE_HTCONFIG_CONNECTED = $09, 567 | LCB_NODE_HTCONFIG_ANY = $11); 568 | 569 | type 570 | lcb_RESPCALLBACK = procedure(instance: lcb_t; cbtype: Integer; const resp: plcb_RESPBASE); cdecl; 571 | 572 | lcb_bootstrap_callback = procedure(instance: lcb_t; err: Lcb_error_t); cdecl; 573 | lcb_timings_callback = procedure(instance: Lcb_t; const cookie: Pointer; timeunit: Lcb_timeunit_t; min: Lcb_U32; max: Lcb_U32; total: Lcb_U32; maxtotal: Lcb_U32); cdecl; 574 | lcb_destroy_callback = procedure(const cookie: Pointer); cdecl; 575 | 576 | { N1QL } 577 | type 578 | lcb_N1QLHANDLE = Pointer; 579 | lcb_N1QLPARAMS = Pointer; 580 | 581 | lcb_RESPN1QL = record 582 | respbase: lcb_RESPBASE; 583 | row: PAnsiChar; 584 | nrow: size_t; 585 | htresp: Pointer{lcb_RESPHTTP}; 586 | end; 587 | 588 | lcb_N1QLCALLBACK = procedure(instance: lcb_t; cbtype: Integer; const resp: lcb_RESPN1QL); cdecl; 589 | 590 | lcb_CMDN1QL = record 591 | cmdflags: lcb_U32; 592 | query: PAnsiChar; 593 | nquery: size_t; 594 | host: PAnsiChar; 595 | content_type: PAnsiChar; 596 | callback: lcb_N1QLCALLBACK; 597 | handle: lcb_N1QLHANDLE; 598 | end; 599 | plcb_CMDN1QL = ^lcb_CMDN1QL; 600 | 601 | { Subdocuments } 602 | 603 | const 604 | LCB_SDCMD_GET = 1; 605 | LCB_SDCMD_EXISTS = 2; 606 | LCB_SDCMD_REPLACE = 3; 607 | LCB_SDCMD_DICT_ADD = 4; 608 | LCB_SDCMD_DICT_UPSERT = 5; 609 | LCB_SDCMD_ARRAY_ADD_FIRST = 6; 610 | LCB_SDCMD_ARRAY_ADD_LAST = 7; 611 | LCB_SDCMD_ARRAY_ADD_UNIQUE = 8; 612 | LCB_SDCMD_ARRAY_INSERT = 9; 613 | LCB_SDCMD_COUNTER = 10; 614 | LCB_SDCMD_REMOVE = 11; 615 | LCB_SDCMD_GET_COUNT = 12; 616 | LCB_SDCMD_MAX = 13; 617 | 618 | LCB_SDSPEC_F_MKINTERMEDIATES = 1 shl 16; 619 | LCB_SDSPEC_F_MKDOCUMENT = 1 shl 17; 620 | 621 | LCB_SDMULTI_MODE_INVALID = 0; 622 | LCB_SDMULTI_MODE_LOOKUP = 1; 623 | LCB_SDMULTI_MODE_MUTATE = 2; 624 | 625 | type 626 | lcb_SUBDOCOP = Integer; 627 | 628 | lcb_SDSPEC = record 629 | sdcmd: lcb_U32; 630 | options: lcb_U32; 631 | path: lcb_KEYBUF; 632 | value: lcb_VALBUF; 633 | end; 634 | plcb_SDSPEC = ^lcb_SDSPEC; 635 | 636 | lcb_CMDSUBDOC = record 637 | cmdbase: lcb_CMDBASE; 638 | specs: plcb_SDSPEC; 639 | nspecs: size_t; 640 | error_index: pInteger; 641 | multimode: lcb_U32; 642 | end; 643 | plcb_CMDSUBDOC = ^lcb_CMDSUBDOC; 644 | 645 | lcb_RESPSUBDOC = record 646 | respbase: lcb_RESPBASE; 647 | responses: Pointer; 648 | bufh: Pointer; 649 | end; 650 | plcb_RESPSUBDOC = ^lcb_RESPSUBDOC; 651 | 652 | lcb_SDENTRY = packed record 653 | value: Pointer; 654 | nvalue: size_t; 655 | status: lcb_error_t; 656 | index: lcb_U8; 657 | end; 658 | plcb_SDENTRY = ^lcb_SDENTRY; 659 | 660 | var 661 | lcb_create: function(instance: plcb_t; const options: plcb_create_st): Lcb_error_t; cdecl = nil; 662 | lcb_connect: function(instance: lcb_t): Lcb_error_t; cdecl = nil; 663 | lcb_set_bootstrap_callback: function(instance: lcb_t; callback: lcb_bootstrap_callback): lcb_bootstrap_callback; cdecl = nil; 664 | lcb_get_bootstrap_status: function(instance: lcb_t): Lcb_error_t; cdecl = nil; 665 | lcb_install_callback3: function(instance: lcb_t; cbtype: Integer; cb: lcb_RESPCALLBACK): lcb_RESPCALLBACK; cdecl = nil; 666 | lcb_get_callback3: function(instance: lcb_t; cbtype: Integer): lcb_RESPCALLBACK; cdecl = nil; 667 | lcb_strcbtype: function(cbtype: Integer): PAnsiChar; cdecl = nil; 668 | lcb_get3: function(instance: lcb_t; const cookie: Pointer; const cmd: plcb_CMDGET): Lcb_error_t; cdecl = nil; 669 | lcb_rget3: function(instance: lcb_t; const cookie: Pointer; const cmd: plcb_CMDGETREPLICA): Lcb_error_t; cdecl = nil; 670 | lcb_store3: function(instance: lcb_t; const cookie: Pointer; const cmd: plcb_CMDSTORE): Lcb_error_t; cdecl = nil; 671 | lcb_remove3: function(instance: lcb_t; const cookie: Pointer; const cmd: plcb_CMDREMOVE): Lcb_error_t; cdecl = nil; 672 | lcb_endure3_ctxnew: function(instance: lcb_t; const options: plcb_durability_opts_t; err: plcb_error_t): plcb_MULTICMD_CTX; cdecl = nil; 673 | lcb_storedur3: function(instance: lcb_t; const cookie: Pointer; const cmd: plcb_CMDSTOREDUR): Lcb_error_t; cdecl = nil; 674 | lcb_durability_validate: function(instance: lcb_t; persist_to: plcb_U16; replicate_to: plcb_U16; options: Integer): Lcb_error_t; cdecl = nil; 675 | lcb_observe3_ctxnew: function(instance: lcb_t): plcb_MULTICMD_CTX; cdecl = nil; 676 | lcb_observe_seqno3: function(instance: lcb_t; const cookie: Pointer; const cmd: plcb_CMDOBSEQNO): Lcb_error_t; cdecl = nil; 677 | lcb_resp_get_mutation_token: function(cbtype: Integer; const rb: plcb_RESPBASE): plcb_MUTATION_TOKEN; cdecl = nil; 678 | lcb_get_mutation_token: function(instance: lcb_t; const kb: plcb_KEYBUF; errp: plcb_error_t): plcb_MUTATION_TOKEN; cdecl = nil; 679 | lcb_counter3: function(instance: lcb_t; const cookie: Pointer; const cmd: plcb_CMDCOUNTER): Lcb_error_t; cdecl = nil; 680 | lcb_unlock3: function(instance: lcb_t; const cookie: Pointer; const cmd: plcb_CMDUNLOCK): Lcb_error_t; cdecl = nil; 681 | lcb_touch3: function(instance: lcb_t; const cookie: Pointer; const cmd: plcb_CMDTOUCH): Lcb_error_t; cdecl = nil; 682 | lcb_stats3: function(instance: lcb_t; const cookie: Pointer; const cmd: plcb_CMDSTATS): Lcb_error_t; cdecl = nil; 683 | lcb_server_versions3: function(instance: lcb_t; const cookie: Pointer; const cmd: plcb_CMDBASE): Lcb_error_t; cdecl = nil; 684 | lcb_server_verbosity3: function(instance: lcb_t; const cookie: Pointer; const cmd: plcb_CMDVERBOSITY): Lcb_error_t; cdecl = nil; 685 | lcb_cbflush3: function(instance: lcb_t; const cookie: Pointer; const cmd: plcb_CMDCBFLUSH): Lcb_error_t; cdecl = nil; 686 | lcb_flush3: function(instance: lcb_t; const cookie: Pointer; const cmd: plcb_CMDFLUSH): Lcb_error_t; cdecl = nil; 687 | lcb_http3: function(instance: lcb_t; const cookie: Pointer; const cmd: plcb_CMDHTTP): Lcb_error_t; cdecl = nil; 688 | lcb_cancel_http_request: procedure(instance: lcb_t; request: lcb_http_request_t); cdecl = nil; 689 | lcb_set_cookie: procedure(instance: lcb_t; const cookie: Pointer); cdecl = nil; 690 | lcb_get_cookie: function(instance: lcb_t): Pointer; cdecl = nil; 691 | lcb_wait: function(instance: lcb_t): Lcb_error_t; cdecl = nil; 692 | lcb_tick_nowait: function(instance: lcb_t): Lcb_error_t; cdecl = nil; 693 | lcb_wait3: procedure(instance: lcb_t; flags: Integer); cdecl = nil; 694 | lcb_breakout: procedure(instance: lcb_t); cdecl = nil; 695 | lcb_is_waiting: function(instance: lcb_t): Integer; cdecl = nil; 696 | lcb_refresh_config: procedure(instance: lcb_t); cdecl = nil; 697 | lcb_sched_enter: procedure(instance: lcb_t); cdecl = nil; 698 | lcb_sched_leave: procedure(instance: lcb_t); cdecl = nil; 699 | lcb_sched_fail: procedure(instance: lcb_t); cdecl = nil; 700 | lcb_sched_flush: procedure(instance: lcb_t); cdecl = nil; 701 | lcb_destroy: procedure(instance: lcb_t); cdecl = nil; 702 | lcb_set_destroy_callback: function(p1: lcb_t; p2: Lcb_destroy_callback): Lcb_destroy_callback; cdecl = nil; 703 | lcb_destroy_async: procedure(instance: lcb_t; const arg: Pointer); cdecl = nil; 704 | lcb_get_node: function(instance: lcb_t; _type: Lcb_GETNODETYPE; index: Cardinal): PAnsiChar; cdecl = nil; 705 | lcb_get_keynode: function(instance: lcb_t; const key: Pointer; nkey: SIZE_T): PAnsiChar; cdecl = nil; 706 | lcb_get_num_replicas: function(instance: lcb_t): Lcb_S32; cdecl = nil; 707 | lcb_get_num_nodes: function(instance: lcb_t): Lcb_S32; cdecl = nil; 708 | lcb_get_server_list: function(instance: lcb_t): PPAnsiChar; cdecl = nil; 709 | lcb_dump: procedure(instance: lcb_t; fp: Pointer; flags: Lcb_U32); cdecl = nil; 710 | lcb_cntl: function(instance: lcb_t; mode: Integer; cmd: Integer; arg: Pointer): Lcb_error_t; cdecl = nil; 711 | lcb_cntl_string: function(instance: lcb_t; const key: PAnsiChar; const value: PAnsiChar): Lcb_error_t; cdecl = nil; 712 | lcb_cntl_setu32: function(instance: lcb_t; cmd: Integer; arg: Lcb_U32): Lcb_error_t; cdecl = nil; 713 | lcb_cntl_getu32: function(instance: lcb_t; cmd: Integer): Lcb_U32; cdecl = nil; 714 | lcb_cntl_exists: function(ctl: Integer): Integer; cdecl = nil; 715 | lcb_enable_timings: function(instance: lcb_t): Lcb_error_t; cdecl = nil; 716 | lcb_disable_timings: function(instance: lcb_t): Lcb_error_t; cdecl = nil; 717 | lcb_get_timings: function(instance: lcb_t; const cookie: Pointer; callback: Lcb_timings_callback): Lcb_error_t; cdecl = nil; 718 | lcb_get_version: function(version: plcb_U32): PAnsiChar; cdecl = nil; 719 | lcb_supports_feature: function(n: Integer): Integer; cdecl = nil; 720 | lcb_mem_alloc: function(size: lcb_size): Pointer; cdecl = nil; 721 | lcb_mem_free: procedure(ptr: Pointer); cdecl = nil; 722 | 723 | { Errors } 724 | lcb_strerror: function(instance: lcb_t; error: lcb_error_t): PAnsiChar; cdecl = nil; 725 | 726 | { Subdocuments } 727 | lcb_subdoc3: function(instance: lcb_t; const cookie: Pointer; const cmd: plcb_CMDSUBDOC): lcb_error_t; cdecl = nil; 728 | lcb_sdresult_next: function(const resp: plcb_RESPSUBDOC; out entry: lcb_SDENTRY; var iter: size_t): Integer; cdecl = nil; 729 | 730 | { N1QL } 731 | lcb_n1p_new: function: lcb_N1QLPARAMS; cdecl = nil; 732 | lcb_n1p_reset: procedure(params: lcb_N1QLPARAMS); cdecl = nil; 733 | lcb_n1p_free: procedure(params: lcb_N1QLPARAMS); cdecl = nil; 734 | lcb_n1p_setquery: function(params: lcb_N1QLPARAMS; const qstr: PAnsiChar; nqstr: Integer; &type: Integer): lcb_error_t; cdecl = nil; 735 | lcb_n1p_namedparam: function(params: lcb_N1QLPARAMS; name: PAnsiChar; n_name: size_t; value: PAnsiChar; n_value: size_t): lcb_error_t; cdecl = nil; 736 | lcb_n1p_posparam: function(params: lcb_N1QLPARAMS; value: PAnsiChar; n_value: size_t): lcb_error_t; cdecl = nil; 737 | lcb_n1p_setopt: function(params: lcb_N1QLPARAMS; name: PAnsiChar; n_name: size_t; value: PAnsiChar; n_value: size_t): lcb_error_t; cdecl = nil; 738 | lcb_n1p_setconsistency: function(params: lcb_N1QLPARAMS; mode: Integer): lcb_error_t; cdecl = nil; 739 | lcb_n1p_setconsistent_token: function(params: lcb_N1QLPARAMS; keyspace: PAnsiChar; const st: lcb_MUTATION_TOKEN): lcb_error_t; cdecl = nil; 740 | lcb_n1p_setconsistent_handle: function(params: lcb_N1QLPARAMS; instance: lcb_t): lcb_error_t; cdecl = nil; 741 | lcb_n1p_encode: function(params: lcb_N1QLPARAMS; rc: plcb_error_t): PAnsiChar; cdecl = nil; 742 | lcb_n1p_mkcmd: function(params: lcb_N1QLPARAMS; cmd: plcb_CMDN1QL): lcb_error_t; cdecl = nil; 743 | lcb_n1ql_query: function(instance: lcb_t; cookie: Pointer; cmd: plcb_CMDN1QL): lcb_error_t; cdecl = nil; 744 | lcb_n1ql_cancel: procedure(instance: lcb_t; handle: lcb_N1QLHANDLE); cdecl = nil; 745 | 746 | { Helpers } 747 | procedure LCB_CMD_SET_KEY(var cmdbase: lcb_CMDBASE; keybuf: Pointer; keylen: Integer); 748 | procedure LCB_CMD_SET_VALUE(var scmd: lcb_CMDSTORE; valbuf: Pointer; vallen: Integer); 749 | procedure LCB_SDSPEC_SET_PATH(var spec: lcb_SDSPEC; pathbuf: Pointer; pathlen: Integer); 750 | procedure LCB_SDSPEC_SET_VALUE(var spec: lcb_SDSPEC; valbuf: Pointer; vallen: Integer); 751 | 752 | implementation 753 | 754 | uses 755 | {$IFDEF MSWINDOWS} 756 | Windows, 757 | {$ENDIF} 758 | SysUtils; 759 | 760 | const 761 | {$IFDEF MSWINDOWS} 762 | COUCHBASE_LIBRARY = 'libcouchbase.dll'; 763 | {$ENDIF} 764 | 765 | var 766 | CouchbaseHandle: HMODULE; 767 | 768 | { Helpers } 769 | 770 | //#define LCB_CMD_SET_KEY(cmd, keybuf, keylen) \ 771 | // LCB_KREQ_SIMPLE(&(cmd)->key, keybuf, keylen) 772 | // 773 | //#define LCB_KREQ_SIMPLE(req, k, nk) do { \ 774 | // (req)->type = LCB_KV_COPY; \ 775 | // (req)->contig.bytes = k; \ 776 | // (req)->contig.nbytes = nk; \ 777 | //} while (0); 778 | 779 | procedure LCB_CMD_SET_KEY(var cmdbase: lcb_CMDBASE; keybuf: Pointer; keylen: Integer); 780 | begin 781 | cmdbase.key.&type := LCB_KV_COPY; 782 | cmdbase.key.contig.bytes := keybuf; 783 | cmdbase.key.contig.nbytes := keylen; 784 | end; 785 | 786 | //#define LCB_CMD_SET_VALUE(scmd, valbuf, vallen) do { \ 787 | // (scmd)->value.vtype = LCB_KV_COPY; \ 788 | // (scmd)->value.u_buf.contig.bytes = valbuf; \ 789 | // (scmd)->value.u_buf.contig.nbytes = vallen; \ 790 | //} while (0); 791 | 792 | procedure LCB_CMD_SET_VALUE(var scmd: lcb_CMDSTORE; valbuf: Pointer; vallen: Integer); 793 | begin 794 | scmd.value.vtype := LCB_KV_COPY; 795 | scmd.value.contig.bytes := valbuf; 796 | scmd.value.contig.nbytes := vallen; 797 | end; 798 | 799 | //#define LCB_SDSPEC_SET_PATH(s, p, n) do { \ 800 | // (s)->path.contig.bytes = p; \ 801 | // (s)->path.contig.nbytes = n; \ 802 | // (s)->path.type = LCB_KV_COPY; \ 803 | //} while (0); 804 | 805 | procedure LCB_SDSPEC_SET_PATH(var spec: lcb_SDSPEC; pathbuf: Pointer; pathlen: Integer); 806 | begin 807 | spec.path.contig.bytes := pathbuf; 808 | spec.path.contig.nbytes := pathlen; 809 | spec.path.&type := LCB_KV_COPY; 810 | end; 811 | 812 | //#define LCB_SDSPEC_SET_VALUE(s, v, n) \ 813 | // LCB_CMD_SET_VALUE(s, v, n) 814 | 815 | procedure LCB_SDSPEC_SET_VALUE(var spec: lcb_SDSPEC; valbuf: Pointer; vallen: Integer); 816 | begin 817 | spec.value.vtype := LCB_KV_COPY; 818 | spec.value.contig.bytes := valbuf; 819 | spec.value.contig.nbytes := vallen; 820 | end; 821 | 822 | //#define lcb_n1p_setstmtz(params, qstr) \ 823 | // lcb_n1p_setquery(params, qstr, -1, LCB_N1P_QUERY_STATEMENT) 824 | 825 | //#define lcb_n1p_namedparamz(params, name, value) \ 826 | // lcb_n1p_namedparam(params, name, -1, value, -1) 827 | 828 | //#define lcb_n1p_setoptz(params, key, value) \ 829 | // lcb_n1p_setopt(params, key, -1, value, -1) 830 | 831 | { Library } 832 | 833 | function LoadLib(const ALibFile: String): HMODULE; 834 | begin 835 | Result := LoadLibrary(PChar(ALibFile)); 836 | if (Result = 0) then 837 | raise Exception.CreateFmt('load %s failed', [ALibFile]); 838 | end; 839 | 840 | function FreeLib(ALibModule: HMODULE): Boolean; 841 | begin 842 | Result := FreeLibrary(ALibModule); 843 | end; 844 | 845 | function GetProc(AModule: HMODULE; const AProcName: String): Pointer; 846 | begin 847 | Result := GetProcAddress(AModule, PChar(AProcName)); 848 | if (Result = nil) then 849 | raise Exception.CreateFmt('%s is not found', [AProcName]); 850 | end; 851 | 852 | procedure LoadCouchbase; 853 | begin 854 | if (CouchbaseHandle <> 0) then Exit; 855 | CouchbaseHandle := LoadLib(COUCHBASE_LIBRARY); 856 | if (CouchbaseHandle = 0) then 857 | begin 858 | raise Exception.CreateFmt('Load %s failed', [COUCHBASE_LIBRARY]); 859 | Exit; 860 | end; 861 | 862 | lcb_create := GetProc(CouchbaseHandle, 'lcb_create'); 863 | lcb_connect := GetProc(CouchbaseHandle, 'lcb_connect'); 864 | lcb_set_bootstrap_callback := GetProc(CouchbaseHandle, 'lcb_set_bootstrap_callback'); 865 | lcb_get_bootstrap_status := GetProc(CouchbaseHandle, 'lcb_get_bootstrap_status'); 866 | lcb_install_callback3 := GetProc(CouchbaseHandle, 'lcb_install_callback3'); 867 | lcb_get_callback3 := GetProc(CouchbaseHandle, 'lcb_get_callback3'); 868 | lcb_strcbtype := GetProc(CouchbaseHandle, 'lcb_strcbtype'); 869 | lcb_get3 := GetProc(CouchbaseHandle, 'lcb_get3'); 870 | lcb_rget3 := GetProc(CouchbaseHandle, 'lcb_rget3'); 871 | lcb_store3 := GetProc(CouchbaseHandle, 'lcb_store3'); 872 | lcb_remove3 := GetProc(CouchbaseHandle, 'lcb_remove3'); 873 | lcb_endure3_ctxnew := GetProc(CouchbaseHandle, 'lcb_endure3_ctxnew'); 874 | lcb_storedur3 := GetProc(CouchbaseHandle, 'lcb_storedur3'); 875 | lcb_durability_validate := GetProc(CouchbaseHandle, 'lcb_durability_validate'); 876 | lcb_observe3_ctxnew := GetProc(CouchbaseHandle, 'lcb_observe3_ctxnew'); 877 | lcb_observe_seqno3 := GetProc(CouchbaseHandle, 'lcb_observe_seqno3'); 878 | lcb_resp_get_mutation_token := GetProc(CouchbaseHandle, 'lcb_resp_get_mutation_token'); 879 | lcb_get_mutation_token := GetProc(CouchbaseHandle, 'lcb_get_mutation_token'); 880 | lcb_counter3 := GetProc(CouchbaseHandle, 'lcb_counter3'); 881 | lcb_unlock3 := GetProc(CouchbaseHandle, 'lcb_unlock3'); 882 | lcb_touch3 := GetProc(CouchbaseHandle, 'lcb_touch3'); 883 | lcb_stats3 := GetProc(CouchbaseHandle, 'lcb_stats3'); 884 | lcb_server_versions3 := GetProc(CouchbaseHandle, 'lcb_server_versions3'); 885 | lcb_server_verbosity3 := GetProc(CouchbaseHandle, 'lcb_server_verbosity3'); 886 | lcb_cbflush3 := GetProc(CouchbaseHandle, 'lcb_cbflush3'); 887 | lcb_flush3 := GetProc(CouchbaseHandle, 'lcb_flush3'); 888 | lcb_http3 := GetProc(CouchbaseHandle, 'lcb_http3'); 889 | lcb_cancel_http_request := GetProc(CouchbaseHandle, 'lcb_cancel_http_request'); 890 | lcb_set_cookie := GetProc(CouchbaseHandle, 'lcb_set_cookie'); 891 | lcb_get_cookie := GetProc(CouchbaseHandle, 'lcb_get_cookie'); 892 | lcb_wait := GetProc(CouchbaseHandle, 'lcb_wait'); 893 | lcb_tick_nowait := GetProc(CouchbaseHandle, 'lcb_tick_nowait'); 894 | lcb_wait3 := GetProc(CouchbaseHandle, 'lcb_wait3'); 895 | lcb_breakout := GetProc(CouchbaseHandle, 'lcb_breakout'); 896 | lcb_is_waiting := GetProc(CouchbaseHandle, 'lcb_is_waiting'); 897 | lcb_refresh_config := GetProc(CouchbaseHandle, 'lcb_refresh_config'); 898 | lcb_sched_enter := GetProc(CouchbaseHandle, 'lcb_sched_enter'); 899 | lcb_sched_leave := GetProc(CouchbaseHandle, 'lcb_sched_leave'); 900 | lcb_sched_fail := GetProc(CouchbaseHandle, 'lcb_sched_fail'); 901 | lcb_sched_flush := GetProc(CouchbaseHandle, 'lcb_sched_flush'); 902 | lcb_destroy := GetProc(CouchbaseHandle, 'lcb_destroy'); 903 | lcb_set_destroy_callback := GetProc(CouchbaseHandle, 'lcb_set_destroy_callback'); 904 | lcb_destroy_async := GetProc(CouchbaseHandle, 'lcb_destroy_async'); 905 | lcb_get_node := GetProc(CouchbaseHandle, 'lcb_get_node'); 906 | lcb_get_keynode := GetProc(CouchbaseHandle, 'lcb_get_keynode'); 907 | lcb_get_num_replicas := GetProc(CouchbaseHandle, 'lcb_get_num_replicas'); 908 | lcb_get_num_nodes := GetProc(CouchbaseHandle, 'lcb_get_num_nodes'); 909 | lcb_get_server_list := GetProc(CouchbaseHandle, 'lcb_get_server_list'); 910 | lcb_dump := GetProc(CouchbaseHandle, 'lcb_dump'); 911 | lcb_cntl := GetProc(CouchbaseHandle, 'lcb_cntl'); 912 | lcb_cntl_string := GetProc(CouchbaseHandle, 'lcb_cntl_string'); 913 | lcb_cntl_setu32 := GetProc(CouchbaseHandle, 'lcb_cntl_setu32'); 914 | lcb_cntl_getu32 := GetProc(CouchbaseHandle, 'lcb_cntl_getu32'); 915 | lcb_cntl_exists := GetProc(CouchbaseHandle, 'lcb_cntl_exists'); 916 | lcb_enable_timings := GetProc(CouchbaseHandle, 'lcb_enable_timings'); 917 | lcb_disable_timings := GetProc(CouchbaseHandle, 'lcb_disable_timings'); 918 | lcb_get_timings := GetProc(CouchbaseHandle, 'lcb_get_timings'); 919 | lcb_get_version := GetProc(CouchbaseHandle, 'lcb_get_version'); 920 | lcb_supports_feature := GetProc(CouchbaseHandle, 'lcb_supports_feature'); 921 | lcb_mem_alloc := GetProc(CouchbaseHandle, 'lcb_mem_alloc'); 922 | lcb_mem_free := GetProc(CouchbaseHandle, 'lcb_mem_free'); 923 | 924 | { Errors } 925 | lcb_strerror := GetProc(CouchbaseHandle, 'lcb_strerror'); 926 | 927 | { Subdocuments } 928 | lcb_subdoc3 := GetProc(CouchbaseHandle, 'lcb_subdoc3'); 929 | lcb_sdresult_next := GetProc(CouchbaseHandle, 'lcb_sdresult_next'); 930 | 931 | { N1QL } 932 | lcb_n1p_new := GetProc(CouchbaseHandle, 'lcb_n1p_new'); 933 | lcb_n1p_reset := GetProc(CouchbaseHandle, 'lcb_n1p_reset'); 934 | lcb_n1p_free := GetProc(CouchbaseHandle, 'lcb_n1p_free'); 935 | lcb_n1p_setquery := GetProc(CouchbaseHandle, 'lcb_n1p_setquery'); 936 | lcb_n1p_namedparam := GetProc(CouchbaseHandle, 'lcb_n1p_namedparam'); 937 | lcb_n1p_posparam := GetProc(CouchbaseHandle, 'lcb_n1p_posparam'); 938 | lcb_n1p_setopt := GetProc(CouchbaseHandle, 'lcb_n1p_setopt'); 939 | lcb_n1p_setconsistency := GetProc(CouchbaseHandle, 'lcb_n1p_setconsistency'); 940 | lcb_n1p_setconsistent_token := GetProc(CouchbaseHandle, 'lcb_n1p_setconsistent_token'); 941 | lcb_n1p_setconsistent_handle := GetProc(CouchbaseHandle, 'lcb_n1p_setconsistent_handle'); 942 | lcb_n1p_encode := GetProc(CouchbaseHandle, 'lcb_n1p_encode'); 943 | lcb_n1p_mkcmd := GetProc(CouchbaseHandle, 'lcb_n1p_mkcmd'); 944 | lcb_n1ql_query := GetProc(CouchbaseHandle, 'lcb_n1ql_query'); 945 | lcb_n1ql_cancel := GetProc(CouchbaseHandle, 'lcb_n1ql_cancel'); 946 | end; 947 | 948 | procedure UnloadCouchbase; 949 | begin 950 | if (CouchbaseHandle = 0) then Exit; 951 | FreeLib(CouchbaseHandle); 952 | CouchbaseHandle := 0; 953 | end; 954 | 955 | initialization 956 | LoadCouchbase; 957 | 958 | finalization 959 | UnloadCouchbase; 960 | 961 | end. -------------------------------------------------------------------------------- /Couchbase.pas: -------------------------------------------------------------------------------- 1 | unit Couchbase; 2 | 3 | { Delphi classes for Couchbase } 4 | 5 | interface 6 | 7 | uses 8 | SysUtils, 9 | System.Generics.Collections, 10 | Couchbase.API; 11 | 12 | type 13 | TCouchbaseFormat = ( 14 | Unknown = 0, 15 | Foreign = 1, 16 | JSON = 2, 17 | RAW = 3, 18 | UTF8 = 4); 19 | 20 | TCouchbaseOptions = record 21 | Format: TCouchbaseFormat; 22 | ExpireTime: UInt32; 23 | CAS: UInt64; 24 | public 25 | procedure Initialize; 26 | end; 27 | 28 | TCouchbaseSubDocResponse = record 29 | Value: Utf8String; 30 | Status: Integer; 31 | end; 32 | TCouchbaseSubDocResponses = TArray; 33 | 34 | type 35 | TCouchbaseResult = record 36 | Success: Boolean; 37 | Error: Integer; 38 | Key: Utf8String; 39 | Value: TBytes; 40 | Format: TCouchbaseFormat; 41 | Flags: Integer; 42 | CAS: Integer; 43 | Operation: Integer; 44 | Counter: Integer; { incr/decr ops } 45 | public 46 | procedure Initialize; 47 | end; 48 | PCouchbaseResult = ^TCouchbaseResult; 49 | 50 | TCouchbaseFlushResult = record 51 | Success: Boolean; 52 | Error: Integer; 53 | Flags: Integer; 54 | CAS: Integer; 55 | Node: Utf8String; { flush/stat ops } 56 | public 57 | procedure Initialize; 58 | end; 59 | PCouchbaseFlushResult = ^TCouchbaseFlushResult; 60 | 61 | TCouchbaseStatsResult = record 62 | Success: Boolean; 63 | Error: Integer; 64 | Stats: TDictionary; 65 | Flags: Integer; 66 | CAS: Integer; 67 | Node: Utf8String; { flush/stat ops } 68 | public 69 | procedure Initialize; 70 | procedure Finalize; 71 | end; 72 | PCouchbaseStatsResult = ^TCouchbaseStatsResult; 73 | 74 | TCouchbaseSubDocResult = record 75 | Success: Boolean; 76 | Error: Integer; 77 | ErrorIndex: Integer; 78 | Key: Utf8String; 79 | Flags: Integer; 80 | CAS: Integer; 81 | Responses: TCouchbaseSubDocResponses; 82 | public 83 | procedure Initialize; 84 | end; 85 | PCouchbaseSubDocResult = ^TCouchbaseSubDocResult; 86 | 87 | TCouchbaseQueryError = record 88 | Code: Integer; 89 | Msg: Utf8String; 90 | end; 91 | 92 | TCouchbaseQueryMetrics = record 93 | ElapsedTime: Utf8String; 94 | ExecutionTime: Utf8String; 95 | ResultCount: Integer; 96 | ResultSize: Integer; 97 | ErrorCount: Integer; 98 | end; 99 | 100 | TCouchbaseQueryResult = record 101 | Success: Boolean; 102 | RequestId: Utf8String; 103 | Errors: TArray; 104 | Status: Utf8String; 105 | Metrics: TCouchbaseQueryMetrics; 106 | Rows: TList; 107 | MetaData: Utf8String; 108 | public 109 | procedure Initialize; 110 | procedure Finalize; 111 | end; 112 | PCouchbaseQueryResult = ^TCouchbaseQueryResult; 113 | 114 | type 115 | TgoCouchbase = class; 116 | 117 | ICouchbaseSubDoc = interface 118 | function Get(const APath: Utf8String): ICouchbaseSubDoc; 119 | function Exists(const APath: Utf8String): ICouchbaseSubDoc; 120 | function GetCount(const APath: Utf8String): ICouchbaseSubDoc; 121 | 122 | function Upsert(const APath: Utf8String; const AValue: TBytes; const ACreateParent: Boolean = True): ICouchbaseSubDoc; overload; 123 | function Upsert(const APath: Utf8String; const AValue: Utf8String; const ACreateParent: Boolean = True): ICouchbaseSubDoc; overload; 124 | 125 | function Insert(const APath: Utf8String; const AValue: TBytes; const ACreateParent: Boolean = True): ICouchbaseSubDoc; overload; 126 | function Insert(const APath: Utf8String; const AValue: Utf8String; const ACreateParent: Boolean = True): ICouchbaseSubDoc; overload; 127 | 128 | function Replace(const APath: Utf8String; const AValue: TBytes): ICouchbaseSubDoc; overload; 129 | function Replace(const APath: Utf8String; const AValue: Utf8String): ICouchbaseSubDoc; overload; 130 | 131 | function Remove(const APath: Utf8String): ICouchbaseSubDoc; 132 | 133 | function ArrayAppend(const APath: Utf8String; const AValue: TBytes; const ACreateParent: Boolean = True): ICouchbaseSubDoc; overload; 134 | function ArrayAppend(const APath: Utf8String; const AValue: Utf8String; const ACreateParent: Boolean = True): ICouchbaseSubDoc; overload; 135 | 136 | function ArrayPrepend(const APath: Utf8String; const AValue: TBytes; const ACreateParent: Boolean = True): ICouchbaseSubDoc; overload; 137 | function ArrayPrepend(const APath: Utf8String; const AValue: Utf8String; const ACreateParent: Boolean = True): ICouchbaseSubDoc; overload; 138 | 139 | function ArrayAddUnique(const APath: Utf8String; const AValue: TBytes; const ACreateParent: Boolean = True): ICouchbaseSubDoc; overload; 140 | function ArrayAddUnique(const APath: Utf8String; const AValue: Utf8String; const ACreateParent: Boolean = True): ICouchbaseSubDoc; overload; 141 | 142 | function ArrayInsert(const APath: Utf8String; const AValue: TBytes): ICouchbaseSubDoc; overload; 143 | function ArrayInsert(const APath: Utf8String; const AValue: Utf8String): ICouchbaseSubDoc; overload; 144 | 145 | function Counter(const APath: Utf8String; const AValue: Utf8String; const ACreateParent: Boolean = True): ICouchbaseSubDoc; 146 | 147 | { Executes the subdocument query } 148 | function Execute: TCouchbaseSubDocResult; 149 | end; 150 | 151 | TgoCouchbaseSubDoc = class(TInterfacedObject, ICouchbaseSubDoc) 152 | protected 153 | FLastErrorCode: Integer; 154 | FLastErrorDesc: String; 155 | function Success(const AResult: Lcb_error_t): Boolean; 156 | private 157 | FCouchbase: TgoCouchbase; 158 | FKey: Utf8String; 159 | FMultiMode: Integer; 160 | private 161 | procedure Append(const ACommand: Integer; const APath: Utf8String); overload; 162 | procedure Append(const ACommand: Integer; const APath: Utf8String; 163 | const AValue: TBytes); overload; 164 | procedure Append(const ACommand: Integer; const APath: Utf8String; 165 | const AValue: TBytes; const ACreateParent: Boolean); overload; 166 | private 167 | FSpecs: TArray; 168 | public 169 | constructor Create(const ACouchbase: TgoCouchbase; const AKey: Utf8String; const AMultiMode: Integer); 170 | destructor Destroy; override; 171 | public 172 | function Get(const APath: Utf8String): ICouchbaseSubDoc; 173 | function Exists(const APath: Utf8String): ICouchbaseSubDoc; 174 | function GetCount(const APath: Utf8String): ICouchbaseSubDoc; 175 | 176 | function Upsert(const APath: Utf8String; const AValue: TBytes; const ACreateParent: Boolean = True): ICouchbaseSubDoc; overload; 177 | function Upsert(const APath: Utf8String; const AValue: Utf8String; const ACreateParent: Boolean = True): ICouchbaseSubDoc; overload; 178 | 179 | function Insert(const APath: Utf8String; const AValue: TBytes; const ACreateParent: Boolean = True): ICouchbaseSubDoc; overload; 180 | function Insert(const APath: Utf8String; const AValue: Utf8String; const ACreateParent: Boolean = True): ICouchbaseSubDoc; overload; 181 | 182 | function Replace(const APath: Utf8String; const AValue: TBytes): ICouchbaseSubDoc; overload; 183 | function Replace(const APath: Utf8String; const AValue: Utf8String): ICouchbaseSubDoc; overload; 184 | 185 | function Remove(const APath: Utf8String): ICouchbaseSubDoc; 186 | 187 | function ArrayAppend(const APath: Utf8String; const AValue: TBytes; const ACreateParent: Boolean = True): ICouchbaseSubDoc; overload; 188 | function ArrayAppend(const APath: Utf8String; const AValue: Utf8String; const ACreateParent: Boolean = True): ICouchbaseSubDoc; overload; 189 | 190 | function ArrayPrepend(const APath: Utf8String; const AValue: TBytes; const ACreateParent: Boolean = True): ICouchbaseSubDoc; overload; 191 | function ArrayPrepend(const APath: Utf8String; const AValue: Utf8String; const ACreateParent: Boolean = True): ICouchbaseSubDoc; overload; 192 | 193 | function ArrayAddUnique(const APath: Utf8String; const AValue: TBytes; const ACreateParent: Boolean = True): ICouchbaseSubDoc; overload; 194 | function ArrayAddUnique(const APath: Utf8String; const AValue: Utf8String; const ACreateParent: Boolean = True): ICouchbaseSubDoc; overload; 195 | 196 | function ArrayInsert(const APath: Utf8String; const AValue: TBytes): ICouchbaseSubDoc; overload; 197 | function ArrayInsert(const APath: Utf8String; const AValue: Utf8String): ICouchbaseSubDoc; overload; 198 | 199 | function Counter(const APath: Utf8String; const AValue: Utf8String; const ACreateParent: Boolean = True): ICouchbaseSubDoc; 200 | 201 | { Executes the subdocument query } 202 | function Execute: TCouchbaseSubDocResult; 203 | public 204 | property LastErrorCode: Integer read FLastErrorCode; 205 | property LastErrorDesc: String read FLastErrorDesc; 206 | end; 207 | 208 | TgoCouchbaseN1QL = class(TObject) 209 | private 210 | FParams: lcb_N1QLPARAMS; 211 | public 212 | constructor Create; 213 | destructor Destroy; override; 214 | public 215 | function SetStatement(const AQuery: Utf8String): Lcb_error_t; 216 | public 217 | property Params: lcb_N1QLPARAMS read FParams; 218 | end; 219 | 220 | TgoCouchbase = class(TObject) 221 | protected 222 | FLastErrorCode: Integer; 223 | FLastErrorDesc: String; 224 | function Success(const AResult: Lcb_error_t): Boolean; 225 | function Store(const AOperation: Integer; const AKey: Utf8String; const AValue: TBytes; 226 | const AOptions: TCouchbaseOptions): TCouchbaseResult; 227 | function StoreRaw(const AOperation: Integer; const AKey: Utf8String; const AValue: TBytes): TCouchbaseResult; 228 | private 229 | FInstance: lcb_t; 230 | FOptions: lcb_create_st; 231 | public 232 | constructor Create; 233 | destructor Destroy; override; 234 | public 235 | function Connect(const AConnection: String; const AUsername: String = ''; const APassword: String = ''): Boolean; 236 | 237 | { Get } 238 | function Get(const AKey: Utf8String; out AValue: TBytes): TCouchbaseResult; overload; 239 | function Get(const AKey: Utf8String; out AValue: String): TCouchbaseResult; overload; 240 | 241 | { Set/Upsert } 242 | function Upsert(const AKey: Utf8String; const AValue: TBytes; const AOptions: TCouchbaseOptions): TCouchbaseResult; overload; 243 | function Upsert(const AKey: Utf8String; const AValue: String; const AOptions: TCouchbaseOptions): TCouchbaseResult; overload; 244 | function Upsert(const AKey: Utf8String; const AValue: String): TCouchbaseResult; overload; 245 | 246 | { Add } 247 | function Add(const AKey: Utf8String; const AValue: TBytes; const AOptions: TCouchbaseOptions): TCouchbaseResult; overload; 248 | function Add(const AKey: Utf8String; const AValue: String; const AOptions: TCouchbaseOptions): TCouchbaseResult; overload; 249 | function Add(const AKey: Utf8String; const AValue: String): TCouchbaseResult; overload; 250 | 251 | { Replace } 252 | function Replace(const AKey: Utf8String; const AValue: TBytes; const AOptions: TCouchbaseOptions): TCouchbaseResult; overload; 253 | function Replace(const AKey: Utf8String; const AValue: String; const AOptions: TCouchbaseOptions): TCouchbaseResult; overload; 254 | function Replace(const AKey: Utf8String; const AValue: String): TCouchbaseResult; overload; 255 | 256 | { Append/Prepend } 257 | function Append(const AKey: Utf8String; const AValue: TBytes): TCouchbaseResult; overload; 258 | function Append(const AKey: Utf8String; const AValue: String): TCouchbaseResult; overload; 259 | function Prepend(const AKey: Utf8String; const AValue: TBytes): TCouchbaseResult; overload; 260 | function Prepend(const AKey: Utf8String; const AValue: String): TCouchbaseResult; overload; 261 | 262 | { Touch } 263 | function Touch(const AKey: Utf8String; const AExpireTime: UInt32 = 0): TCouchbaseResult; 264 | 265 | { Increment/Decrement } 266 | function Incr(const AKey: Utf8String; const ADelta: Integer = 1; const AInitial: Integer = 0; 267 | const ACreate: Boolean = True): TCouchbaseResult; 268 | function Decr(const AKey: Utf8String; const ADelta: Integer = -1; const AInitial: Integer = 0; 269 | const ACreate: Boolean = True): TCouchbaseResult; 270 | 271 | { Delete } 272 | function Delete(const AKey: Utf8String): TCouchbaseResult; 273 | 274 | { Flush } 275 | function Flush: TCouchbaseFlushResult; 276 | 277 | { Stats } 278 | function Stats: TCouchbaseStatsResult; 279 | public 280 | { Subdocuments } 281 | 282 | { Lookup subdoc operations } 283 | function LookupIn(const AKey: Utf8String): ICouchbaseSubDoc; 284 | 285 | { Mutate subdoc operations } 286 | function MutateIn(const AKey: Utf8String): ICouchbaseSubDoc; 287 | public 288 | { N1QL } 289 | 290 | function Query(const AParams: TgoCouchbaseN1QL): TCouchbaseQueryResult; 291 | public 292 | property LastErrorCode: Integer read FLastErrorCode; 293 | property LastErrorDesc: String read FLastErrorDesc; 294 | 295 | { Bucket instance } 296 | property Instance: lcb_t read FInstance; 297 | end; 298 | 299 | implementation 300 | 301 | uses 302 | Grijjy.Bson; 303 | 304 | var 305 | DEFAULT_OPTIONS: TCouchbaseOptions; 306 | 307 | { TCouchbase } 308 | 309 | constructor TgoCouchbase.Create; 310 | begin 311 | FInstance := nil; 312 | end; 313 | 314 | destructor TgoCouchbase.Destroy; 315 | begin 316 | if FInstance <> nil then 317 | begin 318 | lcb_destroy(FInstance); 319 | FInstance := nil; 320 | end; 321 | inherited; 322 | end; 323 | 324 | function TgoCouchbase.Success(const AResult: Lcb_error_t): Boolean; 325 | begin 326 | FLastErrorCode := AResult; 327 | if FLastErrorCode = LCB_SUCCESS then 328 | begin 329 | FLastErrorDesc := 'Success'; 330 | Result := True; 331 | end 332 | else 333 | begin 334 | FLastErrorDesc := String(lcb_strerror(nil, FLastErrorCode)); 335 | Result := False; 336 | end; 337 | end; 338 | 339 | function TgoCouchbase.Store(const AOperation: Integer; const AKey: Utf8String; const AValue: TBytes; 340 | const AOptions: TCouchbaseOptions): TCouchbaseResult; 341 | var 342 | Command: lcb_CMDSTORE; 343 | begin 344 | FillChar(Command, SizeOf(Command), 0); 345 | Result.Initialize; 346 | Command.flags := Integer(AOptions.Format) shl 24; 347 | Command.cmdbase.exptime := AOptions.ExpireTime; 348 | Command.cmdbase.cas := AOptions.CAS; 349 | LCB_CMD_SET_KEY(Command.cmdbase, MarshaledAString(AKey), Length(AKey)); 350 | LCB_CMD_SET_VALUE(Command, AValue, Length(AValue)); 351 | Command.operation := AOperation; 352 | if Success(lcb_store3(FInstance, @Result, @Command)) then 353 | lcb_wait3(FInstance, LCB_WAIT_NOCHECK); 354 | end; 355 | 356 | function TgoCouchbase.StoreRaw(const AOperation: Integer; const AKey: Utf8String; const AValue: TBytes): TCouchbaseResult; 357 | var 358 | Command: lcb_CMDSTORE; 359 | begin 360 | FillChar(Command, SizeOf(Command), 0); 361 | Result.Initialize; 362 | LCB_CMD_SET_KEY(Command.cmdbase, MarshaledAString(AKey), Length(AKey)); 363 | LCB_CMD_SET_VALUE(Command, AValue, Length(AValue)); 364 | Command.operation := AOperation; 365 | if Success(lcb_store3(FInstance, @Result, @Command)) then 366 | lcb_wait3(FInstance, LCB_WAIT_NOCHECK); 367 | end; 368 | 369 | procedure ResponseCallback(AInstance: lcb_t; ACBType: Integer; const AResponseBase: plcb_RESPBASE); cdecl; 370 | var 371 | CBResult: PCouchbaseResult; 372 | ResponseGet: plcb_RESPGET; 373 | ResponseStore: plcb_RESPSTORE; 374 | ResponseCounter: plcb_RESPCOUNTER; 375 | begin 376 | if AResponseBase.cookie <> nil then 377 | begin 378 | CBResult := AResponseBase.cookie; 379 | CBResult.Success := AResponseBase.rc = LCB_SUCCESS; 380 | SetLength(CBResult.Key, AResponseBase.nkey); 381 | Move(AResponseBase.key^, CBResult.Key[1], AResponseBase.nkey); 382 | CBResult.Flags := AResponseBase.rflags; 383 | CBResult.CAS := AResponseBase.cas; 384 | if CBResult.Success then 385 | begin 386 | case ACBType of 387 | LCB_CALLBACK_GET: 388 | begin 389 | ResponseGet := plcb_RESPGET(AResponseBase); 390 | CBResult.Format := TCouchbaseFormat(ResponseGet.itmflags shr 24); 391 | SetLength(CBResult.Value, ResponseGet.nvalue); 392 | Move(ResponseGet.value^, CBResult.Value[0], ResponseGet.nvalue); 393 | end; 394 | LCB_CALLBACK_STORE: 395 | begin 396 | ResponseStore := plcb_RESPSTORE(AResponseBase); 397 | CBResult.Operation := ResponseStore.op; 398 | end; 399 | LCB_CALLBACK_COUNTER: 400 | begin 401 | ResponseCounter := plcb_RESPCOUNTER(AResponseBase); 402 | CBResult.Counter := ResponseCounter.value; 403 | end; 404 | end; 405 | end 406 | else 407 | CBResult.Error := AResponseBase.rc; 408 | end; 409 | end; 410 | 411 | procedure ResponseFlushCallback(AInstance: lcb_t; ACBType: Integer; const AResponseBase: plcb_RESPBASE); cdecl; 412 | var 413 | CBFlushResult: PCouchbaseFlushResult; 414 | ResponseFlush: plcb_RESPFLUSH; 415 | begin 416 | if AResponseBase.cookie <> nil then 417 | begin 418 | CBFlushResult := AResponseBase.cookie; 419 | CBFlushResult.Success := AResponseBase.rc = LCB_SUCCESS; 420 | CBFlushResult.Flags := AResponseBase.rflags; 421 | CBFlushResult.CAS := AResponseBase.cas; 422 | if CBFlushResult.Success then 423 | begin 424 | case ACBType of 425 | LCB_CALLBACK_FLUSH: 426 | begin 427 | ResponseFlush := plcb_RESPFLUSH(AResponseBase); 428 | SetLength(CBFlushResult.Node, Length(ResponseFlush.respserverbase.respserverfields.server)); 429 | Move(ResponseFlush.respserverbase.respserverfields.server^, CBFlushResult.Node[1], Length(ResponseFlush.respserverbase.respserverfields.server)); 430 | end; 431 | end; 432 | end 433 | else 434 | CBFlushResult.Error := AResponseBase.rc; 435 | end; 436 | end; 437 | 438 | procedure ResponseStatsCallback(AInstance: lcb_t; ACBType: Integer; const AResponseBase: plcb_RESPBASE); cdecl; 439 | var 440 | CBStatsResult: PCouchbaseStatsResult; 441 | ResponseStats: plcb_RESPSTATS; 442 | Key: Utf8String; 443 | Value: TBytes; 444 | begin 445 | if AResponseBase.cookie <> nil then 446 | begin 447 | CBStatsResult := AResponseBase.cookie; 448 | CBStatsResult.Success := AResponseBase.rc = LCB_SUCCESS; 449 | CBStatsResult.Flags := AResponseBase.rflags; 450 | CBStatsResult.CAS := AResponseBase.cas; 451 | if CBStatsResult.Success then 452 | begin 453 | case ACBType of 454 | LCB_CALLBACK_STATS: 455 | begin 456 | { the callback for this command is invoked an indeterminate amount number of times and 457 | is finished when resp->rflags & LCB_RESP_F_FINAL } 458 | ResponseStats := plcb_RESPSTATS(AResponseBase); 459 | if (ResponseStats.respserverbase.respbase.rflags AND LCB_RESP_F_FINAL) = 0 then 460 | begin 461 | SetLength(CBStatsResult.Node, Length(ResponseStats.respserverbase.respserverfields.server)); 462 | Move(ResponseStats.respserverbase.respserverfields.server^, CBStatsResult.Node[1], Length(ResponseStats.respserverbase.respserverfields.server)); 463 | SetLength(Key, ResponseStats.respserverbase.respbase.nkey); 464 | Move(ResponseStats.respserverbase.respbase.key^, Key[1], ResponseStats.respserverbase.respbase.nkey); 465 | SetLength(Value, ResponseStats.nvalue); 466 | Move(ResponseStats.value^, Value[0], ResponseStats.nValue); 467 | CBStatsResult.Stats.Add(Key, Value); 468 | end; 469 | end; 470 | end; 471 | end 472 | else 473 | CBStatsResult.Error := AResponseBase.rc; 474 | end; 475 | end; 476 | 477 | procedure ResponseSubDocCallback(AInstance: lcb_t; ACBType: Integer; const AResponseBase: plcb_RESPBASE); cdecl; 478 | var 479 | CBSubDocResult: PCouchbaseSubDocResult; 480 | CBSubDocResponse: TCouchbaseSubDocResponse; 481 | ResponseSubDoc: plcb_RESPSUBDOC; 482 | SDEntry: lcb_SDENTRY; 483 | Iterator: size_t; 484 | Index: Integer; 485 | begin 486 | if AResponseBase.cookie <> nil then 487 | begin 488 | CBSubDocResult := AResponseBase.cookie; 489 | CBSubDocResult.Success := AResponseBase.rc = LCB_SUCCESS; 490 | CBSubDocResult.Error := AResponseBase.rc; 491 | SetLength(CBSubDocResult.Key, AResponseBase.nkey); 492 | Move(AResponseBase.key^, CBSubDocResult.Key[1], AResponseBase.nkey); 493 | CBSubDocResult.Flags := AResponseBase.rflags; 494 | CBSubDocResult.CAS := AResponseBase.cas; 495 | case ACBType of 496 | LCB_CALLBACK_SDLOOKUP, 497 | LCB_CALLBACK_SDMUTATE: 498 | begin 499 | ResponseSubDoc := plcb_RESPSUBDOC(AResponseBase); 500 | Iterator := 0; 501 | Index := 0; 502 | while lcb_sdresult_next(ResponseSubDoc, SDEntry, Iterator) <> 0 do 503 | begin 504 | if ACBType = LCB_CALLBACK_SDMUTATE then 505 | Index := SDEntry.index; { mutate only } 506 | if Length(CBSubDocResult.Responses) < (Index + 1) then 507 | SetLength(CBSubDocResult.Responses, (Index + 1)); 508 | SetLength(CBSubDocResponse.Value, SDEntry.nvalue); 509 | Move(SDEntry.value^, CBSubDocResponse.Value[1], SDEntry.nvalue); { always json } 510 | CBSubDocResponse.Status := SDEntry.status; 511 | CBSubDocResult.Responses[Index] := CBSubDocResponse; 512 | if ACBType = LCB_CALLBACK_SDLOOKUP then 513 | Inc(Index); 514 | end; 515 | end; 516 | end; 517 | end; 518 | end; 519 | 520 | procedure ResponseQueryCallback(AInstance: lcb_t; ACBType: Integer; const AResponse: lcb_RESPN1QL); cdecl; 521 | var 522 | CBQueryResult: PCouchbaseQueryResult; 523 | Value: Utf8String; 524 | begin 525 | if AResponse.respbase.cookie <> nil then 526 | begin 527 | CBQueryResult := AResponse.respbase.cookie; 528 | CBQueryResult.Success := AResponse.respbase.rc = LCB_SUCCESS; 529 | if (AResponse.respbase.rflags AND LCB_RESP_F_FINAL) = 0 then 530 | begin 531 | SetLength(Value, AResponse.nRow); 532 | Move(AResponse.row^, Value[1], AResponse.nRow); 533 | CBQueryResult.Rows.Add(Value); 534 | end 535 | else 536 | begin 537 | // metadata 538 | SetLength(CBQueryResult.MetaData, AResponse.nRow); 539 | Move(AResponse.row^, CBQueryResult.MetaData[1], AResponse.nRow); 540 | end; 541 | end; 542 | end; 543 | 544 | function TgoCouchbase.Connect(const AConnection: String; const AUsername, APassword: String): Boolean; 545 | begin 546 | Result := False; 547 | FillChar(FOptions, SizeOf(FOptions), 0); 548 | FOptions.version := 3; 549 | FOptions.v3.connstr := MarshaledAString(TMarshal.AsAnsi(AConnection)); 550 | FOptions.v3.username := MarshaledAString(TMarshal.AsAnsi(AUsername)); 551 | FOptions.v3.passwd := MarshaledAString(TMarshal.AsAnsi(APassword)); 552 | if Success(lcb_create(@FInstance, @FOptions)) then 553 | if Success(lcb_connect(FInstance)) then 554 | begin 555 | lcb_wait3(FInstance, LCB_WAIT_NOCHECK); 556 | Result := Success(lcb_get_bootstrap_status(FInstance)); 557 | if Result then 558 | begin 559 | { crud callbacks } 560 | lcb_install_callback3(FInstance, LCB_CALLBACK_GET, ResponseCallback); 561 | lcb_install_callback3(FInstance, LCB_CALLBACK_STORE, ResponseCallback); 562 | lcb_install_callback3(FInstance, LCB_CALLBACK_COUNTER, ResponseCallback); 563 | lcb_install_callback3(FInstance, LCB_CALLBACK_TOUCH, ResponseCallback); 564 | lcb_install_callback3(FInstance, LCB_CALLBACK_REMOVE, ResponseCallback); 565 | 566 | { flush/stats callbacks } 567 | lcb_install_callback3(FInstance, LCB_CALLBACK_FLUSH, ResponseFlushCallback); 568 | lcb_install_callback3(FInstance, LCB_CALLBACK_STATS, ResponseStatsCallback); 569 | 570 | { json subdoc callbacks } 571 | lcb_install_callback3(FInstance, LCB_CALLBACK_SDLOOKUP, ResponseSubDocCallback); 572 | lcb_install_callback3(FInstance, LCB_CALLBACK_SDMUTATE, ResponseSubDocCallback); 573 | end; 574 | end; 575 | end; 576 | 577 | function TgoCouchbase.Get(const AKey: Utf8String; out AValue: TBytes): TCouchbaseResult; 578 | var 579 | Command: lcb_CMDGET; 580 | begin 581 | FillChar(Command, SizeOf(Command), 0); 582 | Result.Initialize; 583 | LCB_CMD_SET_KEY(Command.cmdbase, MarshaledAString(AKey), Length(AKey)); 584 | if Success(lcb_get3(FInstance, @Result, @Command)) then 585 | begin 586 | lcb_wait3(FInstance, LCB_WAIT_NOCHECK); 587 | if Result.Success then 588 | AValue := Result.Value; 589 | end; 590 | end; 591 | 592 | function TgoCouchbase.Get(const AKey: Utf8String; out AValue: String): TCouchbaseResult; 593 | var 594 | Value: TBytes; 595 | begin 596 | Result := Get(AKey, Value); 597 | if Result.Success then 598 | AValue := TEncoding.Utf8.GetString(Value); 599 | end; 600 | 601 | function TgoCouchbase.Upsert(const AKey: Utf8String; const AValue: TBytes; 602 | const AOptions: TCouchbaseOptions): TCouchbaseResult; 603 | begin 604 | Result := Store(LCB_SET, AKey, AValue, AOptions); 605 | end; 606 | 607 | function TgoCouchbase.Upsert(const AKey: Utf8String; const AValue: String; 608 | const AOptions: TCouchbaseOptions): TCouchbaseResult; 609 | begin 610 | Result := Store(LCB_SET, AKey, TEncoding.UTF8.GetBytes(AValue), AOptions); 611 | end; 612 | 613 | function TgoCouchbase.Upsert(const AKey: Utf8String; const AValue: String): TCouchbaseResult; 614 | begin 615 | Result := Store(LCB_SET, AKey, TEncoding.UTF8.GetBytes(AValue), DEFAULT_OPTIONS); 616 | end; 617 | 618 | function TgoCouchbase.Add(const AKey: Utf8String; const AValue: TBytes; 619 | const AOptions: TCouchbaseOptions): TCouchbaseResult; 620 | begin 621 | Result := Store(LCB_ADD, AKey, AValue, AOptions); 622 | end; 623 | 624 | function TgoCouchbase.Add(const AKey: Utf8String; const AValue: String; 625 | const AOptions: TCouchbaseOptions): TCouchbaseResult; 626 | begin 627 | Result := Store(LCB_ADD, AKey, TEncoding.UTF8.GetBytes(AValue), AOptions); 628 | end; 629 | 630 | function TgoCouchbase.Add(const AKey: Utf8String; const AValue: String): TCouchbaseResult; 631 | begin 632 | Result := Store(LCB_ADD, AKey, TEncoding.UTF8.GetBytes(AValue), DEFAULT_OPTIONS); 633 | end; 634 | 635 | function TgoCouchbase.Replace(const AKey: Utf8String; const AValue: TBytes; 636 | const AOptions: TCouchbaseOptions): TCouchbaseResult; 637 | begin 638 | Result := Store(LCB_REPLACE, AKey, AValue, AOptions); 639 | end; 640 | 641 | function TgoCouchbase.Replace(const AKey: Utf8String; const AValue: String; 642 | const AOptions: TCouchbaseOptions): TCouchbaseResult; 643 | begin 644 | Result := Store(LCB_REPLACE, AKey, TEncoding.UTF8.GetBytes(AValue), AOptions); 645 | end; 646 | 647 | function TgoCouchbase.Replace(const AKey: Utf8String; const AValue: String): TCouchbaseResult; 648 | begin 649 | Result := Store(LCB_REPLACE, AKey, TEncoding.UTF8.GetBytes(AValue), DEFAULT_OPTIONS); 650 | end; 651 | 652 | function TgoCouchbase.Append(const AKey: Utf8String; const AValue: TBytes): TCouchbaseResult; 653 | begin 654 | Result := StoreRaw(LCB_APPEND, AKey, AValue); 655 | end; 656 | 657 | function TgoCouchbase.Append(const AKey: Utf8String; const AValue: String): TCouchbaseResult; 658 | begin 659 | Result := StoreRaw(LCB_APPEND, AKey, TEncoding.UTF8.GetBytes(AValue)); 660 | end; 661 | 662 | function TgoCouchbase.Prepend(const AKey: Utf8String; const AValue: TBytes): TCouchbaseResult; 663 | begin 664 | Result := StoreRaw(LCB_PREPEND, AKey, AValue); 665 | end; 666 | 667 | function TgoCouchbase.Prepend(const AKey: Utf8String; const AValue: String): TCouchbaseResult; 668 | begin 669 | Result := StoreRaw(LCB_PREPEND, AKey, TEncoding.UTF8.GetBytes(AValue)); 670 | end; 671 | 672 | function TgoCouchbase.Query(const AParams: TgoCouchbaseN1QL): TCouchbaseQueryResult; 673 | var 674 | Command: lcb_CMDN1QL; 675 | Doc, Error, Metrics: TgoBsonDocument; 676 | Errors: TgoBsonArray; 677 | Value: TgoBsonValue; 678 | I: Integer; 679 | begin 680 | FillChar(Command, SizeOf(Command), 0); 681 | Result.Initialize; 682 | Command.callback := ResponseQueryCallback; 683 | if Success(lcb_n1p_mkcmd(AParams.Params, @Command)) then 684 | if Success(lcb_n1ql_query(FInstance, @Result, @Command)) then 685 | begin 686 | lcb_wait3(FInstance, LCB_WAIT_NOCHECK); 687 | if TgoBsonDocument.TryParse(Result.MetaData, Doc) then 688 | begin 689 | Result.Status := Doc['status']; 690 | Result.Success := Result.Status = 'success'; 691 | Result.RequestId := Doc['requestID']; 692 | 693 | if (Doc.TryGetValue('errors', Value)) then 694 | begin 695 | Errors := Value.AsBsonArray; 696 | SetLength(Result.Errors, Errors.Count); 697 | for I := 0 to Errors.Count - 1 do 698 | begin 699 | Error := Errors[I].AsBsonDocument; 700 | Result.Errors[I].Code := Error['code']; 701 | Result.Errors[I].Msg := Error['msg']; 702 | end; 703 | end; 704 | 705 | if (Doc.TryGetValue('metrics', Value)) then 706 | begin 707 | Metrics := Value.AsBsonDocument; 708 | Result.Metrics.ElapsedTime := Metrics['elapsedTime']; 709 | Result.Metrics.ExecutionTime:= Metrics['executionTime']; 710 | Result.Metrics.ResultCount := Metrics['resultCount']; 711 | Result.Metrics.ResultSize := Metrics['resultSize']; 712 | Result.Metrics.ErrorCount := Metrics['errorCount']; 713 | end; 714 | end; 715 | end; 716 | end; 717 | 718 | function TgoCouchbase.Touch(const AKey: Utf8String; const AExpireTime: UInt32): TCouchbaseResult; 719 | var 720 | Command: lcb_CMDTOUCH; 721 | begin 722 | FillChar(Command, SizeOf(Command), 0); 723 | Command.cmdbase.exptime := AExpireTime; 724 | Result.Initialize; 725 | LCB_CMD_SET_KEY(Command.cmdbase, MarshaledAString(AKey), Length(AKey)); 726 | if Success(lcb_touch3(FInstance, @Result, @Command)) then 727 | lcb_wait3(FInstance, LCB_WAIT_NOCHECK); 728 | end; 729 | 730 | function TgoCouchbase.Incr(const AKey: Utf8String; const ADelta: Integer; const AInitial: Integer; 731 | const ACreate: Boolean): TCouchbaseResult; 732 | var 733 | Command: lcb_CMDCOUNTER; 734 | begin 735 | FillChar(Command, SizeOf(Command), 0); 736 | Command.delta := ADelta; 737 | Command.initial := AInitial; 738 | Command.create := Integer(ACreate); 739 | Result.Initialize; 740 | LCB_CMD_SET_KEY(Command.cmdbase, MarshaledAString(AKey), Length(AKey)); 741 | if Success(lcb_counter3(FInstance, @Result, @Command)) then 742 | lcb_wait3(FInstance, LCB_WAIT_NOCHECK); 743 | end; 744 | 745 | function TgoCouchbase.Decr(const AKey: Utf8String; const ADelta: Integer; const AInitial: Integer; 746 | const ACreate: Boolean): TCouchbaseResult; 747 | var 748 | Command: lcb_CMDCOUNTER; 749 | begin 750 | FillChar(Command, SizeOf(Command), 0); 751 | Command.delta := ADelta; 752 | Command.initial := AInitial; 753 | Command.create := Integer(ACreate); 754 | Result.Initialize; 755 | LCB_CMD_SET_KEY(Command.cmdbase, MarshaledAString(AKey), Length(AKey)); 756 | if Success(lcb_counter3(FInstance, @Result, @Command)) then 757 | lcb_wait3(FInstance, LCB_WAIT_NOCHECK); 758 | end; 759 | 760 | function TgoCouchbase.Delete(const AKey: Utf8String): TCouchbaseResult; 761 | var 762 | Command: lcb_CMDREMOVE; 763 | begin 764 | FillChar(Command, SizeOf(Command), 0); 765 | Result.Initialize; 766 | LCB_CMD_SET_KEY(Command.cmdbase, MarshaledAString(AKey), Length(AKey)); 767 | if Success(lcb_remove3(FInstance, @Result, @Command)) then 768 | lcb_wait3(FInstance, LCB_WAIT_NOCHECK); 769 | end; 770 | 771 | function TgoCouchbase.Flush: TCouchbaseFlushResult; 772 | var 773 | Command: lcb_CMDFLUSH; 774 | begin 775 | FillChar(Command, SizeOf(Command), 0); 776 | Result.Initialize; 777 | if Success(lcb_flush3(FInstance, @Result, @Command)) then 778 | lcb_wait3(FInstance, LCB_WAIT_NOCHECK); 779 | end; 780 | 781 | function TgoCouchbase.Stats: TCouchbaseStatsResult; 782 | var 783 | Command: lcb_CMDSTATS; 784 | begin 785 | FillChar(Command, SizeOf(Command), 0); 786 | Result.Initialize; 787 | if Success(lcb_stats3(FInstance, @Result, @Command)) then 788 | lcb_wait3(FInstance, LCB_WAIT_NOCHECK); 789 | end; 790 | 791 | function TgoCouchbase.LookupIn(const AKey: Utf8String): ICouchbaseSubDoc; 792 | begin 793 | Result := TgoCouchbaseSubDoc.Create(Self, AKey, LCB_SDMULTI_MODE_LOOKUP); 794 | end; 795 | 796 | function TgoCouchbase.MutateIn(const AKey: Utf8String): ICouchbaseSubDoc; 797 | begin 798 | Result := TgoCouchbaseSubDoc.Create(Self, AKey, LCB_SDMULTI_MODE_MUTATE); 799 | end; 800 | 801 | { TCouchbaseResult } 802 | 803 | procedure TCouchbaseResult.Initialize; 804 | begin 805 | Success := False; 806 | Error := 0; 807 | Key := ''; 808 | Value := nil; 809 | Format := TCouchbaseFormat.JSON; 810 | Flags := 0; 811 | CAS := 0; 812 | Operation := 0; 813 | Counter := 0; 814 | end; 815 | 816 | { TCouchbaseSubDoc } 817 | 818 | constructor TgoCouchbaseSubDoc.Create(const ACouchbase: TgoCouchbase; 819 | const AKey: Utf8String; const AMultiMode: Integer); 820 | begin 821 | FCouchbase := ACouchbase; 822 | FKey := AKey; 823 | FMultiMode := AMultiMode; 824 | end; 825 | 826 | destructor TgoCouchbaseSubDoc.Destroy; 827 | begin 828 | inherited; 829 | end; 830 | 831 | function TgoCouchbaseSubDoc.Success(const AResult: Lcb_error_t): Boolean; 832 | begin 833 | FLastErrorCode := AResult; 834 | if FLastErrorCode = LCB_SUCCESS then 835 | begin 836 | FLastErrorDesc := 'Success'; 837 | Result := True; 838 | end 839 | else 840 | begin 841 | FLastErrorDesc := String(lcb_strerror(nil, FLastErrorCode)); 842 | Result := False; 843 | end; 844 | end; 845 | 846 | procedure TgoCouchbaseSubDoc.Append(const ACommand: Integer; const APath: Utf8String); 847 | var 848 | Spec: lcb_SDSPEC; 849 | begin 850 | FillChar(Spec, SizeOf(Spec), 0); 851 | Spec.sdcmd := ACommand; 852 | LCB_SDSPEC_SET_PATH(Spec, MarshaledAString(APath), Length(APath)); 853 | FSpecs := FSpecs + [Spec]; 854 | end; 855 | 856 | procedure TgoCouchbaseSubDoc.Append(const ACommand: Integer; const APath: Utf8String; 857 | const AValue: TBytes); 858 | var 859 | Spec: lcb_SDSPEC; 860 | begin 861 | FillChar(Spec, SizeOf(Spec), 0); 862 | Spec.sdcmd := ACommand; 863 | LCB_SDSPEC_SET_PATH(Spec, MarshaledAString(APath), Length(APath)); 864 | LCB_SDSPEC_SET_VALUE(Spec, AValue, Length(AValue)); 865 | FSpecs := FSpecs + [Spec]; 866 | end; 867 | 868 | procedure TgoCouchbaseSubDoc.Append(const ACommand: Integer; const APath: Utf8String; 869 | const AValue: TBytes; const ACreateParent: Boolean); 870 | var 871 | Spec: lcb_SDSPEC; 872 | begin 873 | FillChar(Spec, SizeOf(Spec), 0); 874 | Spec.sdcmd := ACommand; 875 | if ACreateParent then 876 | Spec.options := LCB_SDSPEC_F_MKINTERMEDIATES; 877 | LCB_SDSPEC_SET_PATH(Spec, MarshaledAString(APath), Length(APath)); 878 | LCB_SDSPEC_SET_VALUE(Spec, AValue, Length(AValue)); 879 | FSpecs := FSpecs + [Spec]; 880 | end; 881 | 882 | function TgoCouchbaseSubDoc.Get(const APath: Utf8String): ICouchbaseSubDoc; 883 | begin 884 | Append(LCB_SDCMD_GET, APath); 885 | Result := Self; 886 | end; 887 | 888 | function TgoCouchbaseSubDoc.Exists(const APath: Utf8String): ICouchbaseSubDoc; 889 | begin 890 | Append(LCB_SDCMD_EXISTS, APath); 891 | Result := Self; 892 | end; 893 | 894 | function TgoCouchbaseSubDoc.GetCount(const APath: Utf8String): ICouchbaseSubDoc; 895 | begin 896 | Append(LCB_SDCMD_GET_COUNT, APath); 897 | Result := Self; 898 | end; 899 | 900 | function TgoCouchbaseSubDoc.Upsert(const APath: Utf8String; 901 | const AValue: TBytes; const ACreateParent: Boolean): ICouchbaseSubDoc; 902 | begin 903 | Append(LCB_SDCMD_DICT_UPSERT, APath, AValue, ACreateParent); 904 | Result := Self; 905 | end; 906 | 907 | function TgoCouchbaseSubDoc.Upsert(const APath: Utf8String; 908 | const AValue: Utf8String; const ACreateParent: Boolean): ICouchbaseSubDoc; 909 | begin 910 | Upsert(APath, TEncoding.UTF8.GetBytes(AValue), ACreateParent); 911 | Result := Self; 912 | end; 913 | 914 | function TgoCouchbaseSubDoc.Insert(const APath: Utf8String; 915 | const AValue: TBytes; const ACreateParent: Boolean): ICouchbaseSubDoc; 916 | begin 917 | Append(LCB_SDCMD_DICT_ADD, APath, AValue, ACreateParent); 918 | Result := Self; 919 | end; 920 | 921 | function TgoCouchbaseSubDoc.Insert(const APath: Utf8String; 922 | const AValue: Utf8String; const ACreateParent: Boolean): ICouchbaseSubDoc; 923 | begin 924 | Insert(APath, TEncoding.UTF8.GetBytes(AValue), ACreateParent); 925 | Result := Self; 926 | end; 927 | 928 | function TgoCouchbaseSubDoc.Replace(const APath: Utf8String; 929 | const AValue: TBytes): ICouchbaseSubDoc; 930 | begin 931 | Append(LCB_SDCMD_REPLACE, APath, AValue); 932 | Result := Self; 933 | end; 934 | 935 | function TgoCouchbaseSubDoc.Replace(const APath: Utf8String; 936 | const AValue: Utf8String): ICouchbaseSubDoc; 937 | begin 938 | Replace(APath, TEncoding.UTF8.GetBytes(AValue)); 939 | Result := Self; 940 | end; 941 | 942 | function TgoCouchbaseSubDoc.Remove(const APath: Utf8String): ICouchbaseSubDoc; 943 | begin 944 | Append(LCB_SDCMD_REMOVE, APath); 945 | Result := Self; 946 | end; 947 | 948 | function TgoCouchbaseSubDoc.ArrayAppend(const APath: Utf8String; 949 | const AValue: TBytes; const ACreateParent: Boolean): ICouchbaseSubDoc; 950 | begin 951 | Append(LCB_SDCMD_ARRAY_ADD_LAST, APath, AValue, ACreateParent); 952 | Result := Self; 953 | end; 954 | 955 | function TgoCouchbaseSubDoc.ArrayAppend(const APath: Utf8String; 956 | const AValue: Utf8String; const ACreateParent: Boolean): ICouchbaseSubDoc; 957 | begin 958 | ArrayAppend(APath, TEncoding.UTF8.GetBytes(AValue), ACreateParent); 959 | Result := Self; 960 | end; 961 | 962 | function TgoCouchbaseSubDoc.ArrayPrepend(const APath: Utf8String; 963 | const AValue: TBytes; const ACreateParent: Boolean): ICouchbaseSubDoc; 964 | begin 965 | Append(LCB_SDCMD_ARRAY_ADD_FIRST, APath, AValue, ACreateParent); 966 | Result := Self; 967 | end; 968 | 969 | function TgoCouchbaseSubDoc.ArrayPrepend(const APath: Utf8String; 970 | const AValue: Utf8String; const ACreateParent: Boolean): ICouchbaseSubDoc; 971 | begin 972 | ArrayPrepend(APath, TEncoding.UTF8.GetBytes(AValue), ACreateParent); 973 | Result := Self; 974 | end; 975 | 976 | function TgoCouchbaseSubDoc.ArrayInsert(const APath: Utf8String; 977 | const AValue: TBytes): ICouchbaseSubDoc; 978 | begin 979 | Append(LCB_SDCMD_ARRAY_INSERT, APath, AValue, False); 980 | Result := Self; 981 | end; 982 | 983 | function TgoCouchbaseSubDoc.ArrayInsert(const APath: Utf8String; 984 | const AValue: Utf8String): ICouchbaseSubDoc; 985 | begin 986 | ArrayInsert(APath, TEncoding.UTF8.GetBytes(AValue)); 987 | Result := Self; 988 | end; 989 | 990 | function TgoCouchbaseSubDoc.ArrayAddUnique(const APath: Utf8String; 991 | const AValue: TBytes; const ACreateParent: Boolean): ICouchbaseSubDoc; 992 | begin 993 | Append(LCB_SDCMD_ARRAY_ADD_UNIQUE, APath, AValue, ACreateParent); 994 | Result := Self; 995 | end; 996 | 997 | function TgoCouchbaseSubDoc.ArrayAddUnique(const APath: Utf8String; 998 | const AValue: Utf8String; const ACreateParent: Boolean): ICouchbaseSubDoc; 999 | begin 1000 | ArrayAddUnique(APath, TEncoding.UTF8.GetBytes(AValue), ACreateParent); 1001 | Result := Self; 1002 | end; 1003 | 1004 | function TgoCouchbaseSubDoc.Counter(const APath: Utf8String; 1005 | const AValue: Utf8String; const ACreateParent: Boolean): ICouchbaseSubDoc; 1006 | begin 1007 | Append(LCB_SDCMD_COUNTER, APath, TEncoding.UTF8.GetBytes(AValue), ACreateParent); 1008 | Result := Self; 1009 | end; 1010 | 1011 | function TgoCouchbaseSubDoc.Execute: TCouchbaseSubDocResult; 1012 | var 1013 | Command: lcb_CMDSUBDOC; 1014 | begin 1015 | FillChar(Command, SizeOf(Command), 0); 1016 | Command.specs := @FSpecs[0]; 1017 | Command.nspecs := Length(FSpecs); 1018 | Command.multimode := FMultiMode; 1019 | Result.Initialize; 1020 | LCB_CMD_SET_KEY(Command.cmdbase, MarshaledAString(FKey), Length(FKey)); 1021 | if Success(lcb_subdoc3(FCouchbase.Instance, @Result, @Command)) then 1022 | lcb_wait3(FCouchbase.Instance, LCB_WAIT_NOCHECK); 1023 | end; 1024 | 1025 | { TCouchbaseN1QL } 1026 | 1027 | constructor TgoCouchbaseN1QL.Create; 1028 | begin 1029 | FParams := lcb_n1p_new; 1030 | end; 1031 | 1032 | destructor TgoCouchbaseN1QL.Destroy; 1033 | begin 1034 | lcb_n1p_free(FParams); 1035 | inherited; 1036 | end; 1037 | 1038 | function TgoCouchbaseN1QL.SetStatement(const AQuery: Utf8String): Lcb_error_t; 1039 | begin 1040 | Result := lcb_n1p_setquery(FParams, MarshaledAString(AQuery), -1, LCB_N1P_QUERY_STATEMENT); 1041 | end; 1042 | 1043 | { TCouchbaseSubDocResult } 1044 | 1045 | procedure TCouchbaseSubDocResult.Initialize; 1046 | begin 1047 | Success := False; 1048 | Error := 0; 1049 | ErrorIndex := 0; 1050 | Key := ''; 1051 | Flags := 0; 1052 | CAS := 0; 1053 | Responses := nil; 1054 | end; 1055 | 1056 | { TCouchbaseOptions } 1057 | 1058 | procedure TCouchbaseOptions.Initialize; 1059 | begin 1060 | Format := TCouchbaseFormat.JSON; 1061 | ExpireTime := 0; 1062 | CAS := 0; 1063 | end; 1064 | 1065 | { TCouchbaseFlushResult } 1066 | 1067 | procedure TCouchbaseFlushResult.Initialize; 1068 | begin 1069 | Success := False; 1070 | Error := 0; 1071 | Flags := 0; 1072 | CAS := 0; 1073 | Node := ''; 1074 | end; 1075 | 1076 | { TCouchbaseStatsResult } 1077 | 1078 | procedure TCouchbaseStatsResult.Initialize; 1079 | begin 1080 | Success := False; 1081 | Error := 0; 1082 | Stats := TDictionary.Create; 1083 | Flags := 0; 1084 | CAS := 0; 1085 | Node := ''; 1086 | end; 1087 | 1088 | procedure TCouchbaseStatsResult.Finalize; 1089 | begin 1090 | Stats.Free; 1091 | end; 1092 | 1093 | { TCouchbaseQueryResult } 1094 | 1095 | procedure TCouchbaseQueryResult.Initialize; 1096 | begin 1097 | Success := False; 1098 | Errors := nil; 1099 | Status := ''; 1100 | Rows := TList.Create; 1101 | MetaData := ''; 1102 | Metrics.ElapsedTime := ''; 1103 | Metrics.ExecutionTime := ''; 1104 | Metrics.ResultCount := 0; 1105 | Metrics.ResultSize := 0; 1106 | Metrics.ErrorCount := 0; 1107 | end; 1108 | 1109 | procedure TCouchbaseQueryResult.Finalize; 1110 | begin 1111 | Rows.Free; 1112 | end; 1113 | 1114 | initialization 1115 | DEFAULT_OPTIONS.Initialize; 1116 | 1117 | end. 1118 | -------------------------------------------------------------------------------- /License.txt: -------------------------------------------------------------------------------- 1 | TGoCouchbase and DelphiCouchbase is licensed under the Simplified BSD License. 2 | 3 | ------------------------------------------------------------------------------- 4 | 5 | Copyright (c) 2017 by Grijjy, Inc. 6 | All rights reserved. 7 | 8 | Redistribution and use in source and binary forms, with or without 9 | modification, are permitted provided that the following conditions are met: 10 | 11 | 1. Redistributions of source code must retain the above copyright notice, this 12 | list of conditions and the following disclaimer. 13 | 2. Redistributions in binary form must reproduce the above copyright notice, 14 | this list of conditions and the following disclaimer in the documentation 15 | and/or other materials provided with the distribution. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 19 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 20 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 21 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 22 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 23 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 24 | ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 26 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Working with big data databases in Delphi – Cassandra, Couchbase and MongoDB (Part 2 of 3) 2 | 3 | This is the second part of a three-part series on working with big data databases directly from Delphi. In this second part we focus on a basic class framework for working with Couchbase along with unit tests and examples.![](http://i.imgur.com/bPiGRvJ.png) 4 | 5 | [Part 1](https://github.com/grijjy/DelphiCassandra) focuses on Cassandra, [Part 2](https://github.com/grijjy/DelphiCouchbase) focuses on Couchbase and Part 3 focuses on MongoDB. 6 | 7 | For more information about us, our support and services visit the [Grijjy homepage](http://www.grijjy.com) or the [Grijjy developers blog](http://blog.grijjy.com). 8 | 9 | The example contained here depends upon part of our [Grijjy Foundation library](https://github.com/grijjy/GrijjyFoundation). 10 | 11 | The source code and related example repository is hosted on GitHub at [https://github.com/grijjy/DelphiCouchbase](https://github.com/grijjy/DelphiCouchbase). 12 | 13 | ## Introduction to Couchbase 14 | [Couchbase](https://www.couchbase.com/) is a high-performance NoSQL database renowned for it's speed and flexibility. 15 | 16 | It combines some of the best aspects of other leading NoSQL databases into a model which is easy to deploy, maintain and scale. Couchbase offers many things in addition to administrative tools, which are included, they also have solutions for mobile platforms. Couchbase is widely used in Internet and cloud based apps and services and continues to grow in popularity. 17 | 18 | Couchbase isn't directly tied to storing and retrieving JSON, any binary content can be stored and easily retrieved. However, Couchbase offers subdocument capabilities that provide direct JSON manipulation (much like MongoDB) but doesn't directly tie you to a rigid schema. 19 | 20 | This is by no means an exhaustive look at the benefits of Couchbase. If you are truly interested there are wealth of [resources online on the how to use Couchbase](https://developer.couchbase.com/). 21 | 22 | ## Delphi and Couchbase 23 | In order to use Couchbase from Delphi we created a header conversion for the latest C library SDK interface provided by Couchbase. The C/C++ interface is relatively new, and provides the most common CRUD operations but also provides subdocument APIs for working directly with JSON documents. 24 | 25 | The examples here is for Delphi on Windows using a Couchbase remote database running on Linux. We use [Ubuntu 16.04 LTS](https://www.ubuntu.com/download) for our examples. 26 | 27 | ## Installing Couchbase Server 28 | 29 | Installing the Couchbase server is a fairly straightforward effort thanks to excellent documentation available on their website. We prefer Ubuntu so the instructions set forth here are focused on that Linux flavor. 30 | 31 | Installing Couchbase involves 3 main steps: 32 | 33 | 1. Install [Ubuntu 16.04 LTS](https://www.ubuntu.com/download). 34 | 2. [Download Couchbase Server](https://www.couchbase.com/nosql-databases/downloads#couchbase-server) for Ubuntu (currently 14.04 official) 35 | 3. Install Couchbase Server (currently 4.6 pre-release) 36 | 37 | ### To install Couchbase 4.6 for Ubuntu: 38 | ```shell 39 | sudo dpkg -i couchbase-server-enterprise_4.6.0-DP-ubuntu14.04_amd64.deb 40 | ``` 41 | 42 | ### On Ubuntu if you want Couchbase to always start when the system restarts, then type: 43 | ```shell 44 | systemctl start couchbase-server 45 | systemctl enable couchbase-server 46 | ``` 47 | 48 | ## LibCouchbase 49 | 50 | In order to interact with Couchbase from Delphi we use the C/C++ SDK library provided by Couchbase. The library headers are converted to Delphi and we wrap it in an easy to use Delphi class architecture. 51 | 52 | The [pre-compiled libraries for the C SDK](https://developer.couchbase.com/server/other-products/release-notes-archives/c-sdk) for Couchbase can be located under the C SDK section of the website. 53 | 54 | For our purposes we are using the *libcouchbase.dll* library contained in the Visual Studio 2012 x86-vc11 library. 55 | 56 | ## TgoCouchbase Class Architecture 57 | 58 | The TgoCouchbase class architecture closely mirrors the API model provided by Couchbase for other APIs such as C/C++ and Python with most of the core operations named the same. 59 | 60 | ```Delphi 61 | TgoCouchbase = class(TObject) 62 | public 63 | constructor Create; 64 | destructor Destroy; override; 65 | public 66 | function Connect(const AConnection: String; const AUsername: String = ''; const APassword: String = ''): Boolean; 67 | 68 | { Get } 69 | function Get(const AKey: Utf8String; out AValue: TBytes): TCouchbaseResult; overload; 70 | function Get(const AKey: Utf8String; out AValue: String): TCouchbaseResult; overload; 71 | 72 | { Set/Upsert } 73 | function Upsert(const AKey: Utf8String; const AValue: TBytes; const AOptions: TCouchbaseOptions): TCouchbaseResult; overload; 74 | function Upsert(const AKey: Utf8String; const AValue: String; const AOptions: TCouchbaseOptions): TCouchbaseResult; overload; 75 | function Upsert(const AKey: Utf8String; const AValue: String): TCouchbaseResult; overload; 76 | 77 | { Add } 78 | function Add(const AKey: Utf8String; const AValue: TBytes; const AOptions: TCouchbaseOptions): TCouchbaseResult; overload; 79 | function Add(const AKey: Utf8String; const AValue: String; const AOptions: TCouchbaseOptions): TCouchbaseResult; overload; 80 | function Add(const AKey: Utf8String; const AValue: String): TCouchbaseResult; overload; 81 | 82 | { Replace } 83 | function Replace(const AKey: Utf8String; const AValue: TBytes; const AOptions: TCouchbaseOptions): TCouchbaseResult; overload; 84 | function Replace(const AKey: Utf8String; const AValue: String; const AOptions: TCouchbaseOptions): TCouchbaseResult; overload; 85 | function Replace(const AKey: Utf8String; const AValue: String): TCouchbaseResult; overload; 86 | 87 | { Append/Prepend } 88 | function Append(const AKey: Utf8String; const AValue: TBytes): TCouchbaseResult; overload; 89 | function Append(const AKey: Utf8String; const AValue: String): TCouchbaseResult; overload; 90 | function Prepend(const AKey: Utf8String; const AValue: TBytes): TCouchbaseResult; overload; 91 | function Prepend(const AKey: Utf8String; const AValue: String): TCouchbaseResult; overload; 92 | 93 | { Touch } 94 | function Touch(const AKey: Utf8String; const AExpireTime: UInt32 = 0): TCouchbaseResult; 95 | 96 | { Increment/Decrement } 97 | function Incr(const AKey: Utf8String; const ADelta: Integer = 1; const AInitial: Integer = 0; 98 | const ACreate: Boolean = True): TCouchbaseResult; 99 | function Decr(const AKey: Utf8String; const ADelta: Integer = -1; const AInitial: Integer = 0; 100 | const ACreate: Boolean = True): TCouchbaseResult; 101 | 102 | { Delete } 103 | function Delete(const AKey: Utf8String): TCouchbaseResult; 104 | 105 | { Flush } 106 | function Flush: TCouchbaseFlushResult; 107 | 108 | { Stats } 109 | function Stats: TCouchbaseStatsResult; 110 | public 111 | { Subdocuments } 112 | 113 | { Lookup subdoc operations } 114 | function LookupIn(const AKey: Utf8String): ICouchbaseSubDoc; 115 | 116 | { Mutate subdoc operations } 117 | function MutateIn(const AKey: Utf8String): ICouchbaseSubDoc; 118 | public 119 | { N1QL } 120 | 121 | function Query(const AParams: TgoCouchbaseN1QL): TCouchbaseQueryResult; 122 | public 123 | property LastErrorCode: Integer read FLastErrorCode; 124 | property LastErrorDesc: String read FLastErrorDesc; 125 | 126 | { Bucket instance } 127 | property Instance: lcb_t read FInstance; 128 | end; 129 | ``` 130 | 131 | ## Connecting to Couchbase 132 | 133 | To connect to Couchbase you first create an instance of the TgoCouchbase class and then call ```Connect``` using a Couchbase connection string which in our case is the address of your Couchbase server. 134 | 135 | ```Delphi 136 | var 137 | Couchbase := TgoCouchbase.Create; 138 | ReturnValue: Boolean; 139 | begin 140 | Couchbase := TgoCouchbase.Create; 141 | try 142 | ReturnValue := Couchbase.Connect('couchbase://192.168.1.84'); 143 | if ReturnValue then 144 | begin 145 | // Connected 146 | end 147 | else 148 | Writeln(Couchbase.LastErrorDesc); 149 | finally 150 | Couchbase.Free; 151 | end; 152 | end; 153 | ``` 154 | If the connection fails you can examine ```Couchbase.LastErrorCode``` and ```Couchbase.LastErrorDesc```. A list of error codes are provided below. 155 | 156 | ## Working with Raw Data 157 | 158 | In Couchbase you define whether the data you are working with is RAW binary data or specific JSON document content. Since we default in our base class to JSON, you need to create a ```TCouchbaseOptions``` record to indicate the data format. In the case of RAW data you are working with any flexible and dynamic content you decide but you must indicate to the API that it is RAW. 159 | 160 | ### Upsert 161 | To insert (or update) RAW content to a key. 162 | ```Delphi 163 | var 164 | CBResult: TCouchbaseResult; 165 | CBOptions: TCouchbaseOptions; 166 | AValue: String; 167 | begin 168 | CBOptions.Initialize; 169 | CBOptions.Format := TCouchbaseFormat.RAW; 170 | CBResult := FCouchbase.Upsert('Value', '1', CBOptions); 171 | end; 172 | ``` 173 | This will set the key of 'Value' to the RAW data '1'. If the operation succeeds then ```CBResult.Success``` will be ```True```. 174 | 175 | ### Get 176 | To get RAW content from an existing key. 177 | ```Delphi 178 | var 179 | CBResult: TCouchbaseResult; 180 | AValue: String; 181 | begin 182 | CBResult := FCouchbase.Get('Value', AValue); 183 | end; 184 | ``` 185 | In this example, ```CBResult.Success``` will return ```True``` if everything succeeds, ```CBResult.Format``` will return ```TCouchbaseFormat.RAW``` and ```AValue``` will contain ```'1'```. 186 | 187 | ### Incr 188 | To increment the value of an existing key by 1. 189 | ```Delphi 190 | var 191 | CBResult: TCouchbaseResult; 192 | begin 193 | CBResult := FCouchbase.Incr('Value'); 194 | end; 195 | ``` 196 | In the above example, if ```Value``` was previously set to ```'1'``` it will now become ```'2'```. 197 | 198 | ### Decr 199 | To decrement the value of an existing key by 1. 200 | ```Delphi 201 | var 202 | CBResult: TCouchbaseResult; 203 | begin 204 | CBResult := FCouchbase.Decr('Value'); 205 | end; 206 | ``` 207 | In the above example, if ```Value``` was previously set to ```'2'``` it will now become ```'1'```. 208 | 209 | ### Append 210 | To append RAW content to an existing key. 211 | ```Delphi 212 | var 213 | CBResult: TCouchbaseResult; 214 | begin 215 | CBResult := FCouchbase.Append('Value', 'DEF'); 216 | end; 217 | ``` 218 | In the above example, assuming ```Value``` was previously set to ```'1'``` it would now contain ```'1DEF'```. 219 | 220 | ### Prepend 221 | To prepend RAW content to an existing key. 222 | ```Delphi 223 | var 224 | CBResult: TCouchbaseResult; 225 | begin 226 | CBResult := FCouchbase.Prepend('Value', 'ABC'); 227 | end; 228 | ``` 229 | In the above example, assuming ```Value``` was previously set to ```'1'``` it would now contain ```'ABC1'```. 230 | 231 | ## TCouchbaseResult 232 | 233 | All core operations return a ```TCouchbaseResult``` that implements the common result operations from Couchbase transactions. 234 | 235 | ```Delphi 236 | TCouchbaseResult = record 237 | Success: Boolean; 238 | Error: Integer; 239 | Key: Utf8String; 240 | Value: TBytes; 241 | Format: TCouchbaseFormat; 242 | Flags: Integer; 243 | CAS: Integer; 244 | Operation: Integer; 245 | Counter: Integer; { incr/decr ops } 246 | end; 247 | ``` 248 | The ```Success``` parameter will indicate ```True``` if the operation was successful and ```False``` if it failed. 249 | 250 | In the event the operation failed, you can check the ```Error``` value which will correspond to a Couchbase error code. 251 | ```Delphi 252 | { Error codes } 253 | LCB_SUCCESS = $00; 254 | LCB_AUTH_CONTINUE = $01; 255 | LCB_AUTH_ERROR = $02; 256 | LCB_DELTA_BADVAL = $03; 257 | LCB_E2BIG = $04; 258 | LCB_EBUSY = $05; 259 | LCB_EINTERNAL = $06; 260 | LCB_EINVAL = $07; 261 | LCB_ENOMEM = $08; 262 | LCB_ERANGE = $09; 263 | LCB_OTHER_ERROR = $0A; 264 | LCB_ETMPFAIL = $0B; 265 | LCB_KEY_EEXISTS = $0C; 266 | LCB_KEY_ENOENT = $0D; 267 | LCB_DLOPEN_FAILED = $0E; 268 | LCB_DLSYM_FAILED = $0F; 269 | LCB_NETWORK_ERROR = $10; 270 | LCB_NOT_MY_VBUCKET = $11; 271 | LCB_NOT_STORED = $12; 272 | LCB_NOT_SUPPORTED = $13; 273 | LCB_UNKNOWN_COMMAND = $14; 274 | LCB_UNKNOWN_HOST = $15; 275 | LCB_PROTOCOL_ERROR = $16; 276 | LCB_ETIMEDOUT = $17; 277 | LCB_CONNECT_ERROR = $18; 278 | LCB_BUCKET_ENOENT = $19; 279 | LCB_CLIENT_ENOMEM = $1A; 280 | LCB_CLIENT_ENOCONF = $1B; 281 | LCB_EBADHANDLE = $1C; 282 | LCB_SERVER_BUG = $1D; 283 | LCB_PLUGIN_VERSION_MISMATCH = $1E; 284 | LCB_INVALID_HOST_FORMAT = $1F; 285 | LCB_INVALID_CHAR = $20; 286 | LCB_DURABILITY_ETOOMANY = $21; 287 | LCB_DUPLICATE_COMMANDS = $22; 288 | LCB_NO_MATCHING_SERVER = $23; 289 | LCB_BAD_ENVIRONMENT = $24; 290 | LCB_BUSY = $25; 291 | LCB_INVALID_USERNAME = $26; 292 | LCB_CONFIG_CACHE_INVALID = $27; 293 | LCB_SASLMECH_UNAVAILABLE = $28; 294 | LCB_TOO_MANY_REDIRECTS = $29; 295 | LCB_MAP_CHANGED = $2A; 296 | LCB_INCOMPLETE_PACKET = $2B; 297 | LCB_ECONNREFUSED = $2C; 298 | LCB_ESOCKSHUTDOWN = $2D; 299 | LCB_ECONNRESET = $2E; 300 | LCB_ECANTGETPORT = $2F; 301 | LCB_EFDLIMITREACHED = $30; 302 | LCB_ENETUNREACH = $31; 303 | LCB_ECTL_UNKNOWN = $32; 304 | LCB_ECTL_UNSUPPMODE = $33; 305 | LCB_ECTL_BADARG = $34; 306 | LCB_EMPTY_KEY = $35; 307 | LCB_SSL_ERROR = $36; 308 | LCB_SSL_CANTVERIFY = $37; 309 | LCB_SCHEDFAIL_INTERNAL = $38; 310 | LCB_CLIENT_FEATURE_UNAVAILABLE = $39; 311 | LCB_OPTIONS_CONFLICT = $3A; 312 | LCB_HTTP_ERROR = $3B; 313 | LCB_DURABILITY_NO_MUTATION_TOKENS = $3C; 314 | LCB_UNKNOWN_MEMCACHED_ERROR = $3D; 315 | LCB_MUTATION_LOST = $3E; 316 | LCB_SUBDOC_PATH_ENOENT = $3F; 317 | LCB_SUBDOC_PATH_MISMATCH = $40; 318 | LCB_SUBDOC_PATH_EINVAL = $41; 319 | LCB_SUBDOC_PATH_E2BIG = $42; 320 | LCB_SUBDOC_DOC_E2DEEP = $43; 321 | LCB_SUBDOC_VALUE_CANTINSERT = $44; 322 | LCB_SUBDOC_DOC_NOTJSON = $45; 323 | LCB_SUBDOC_NUM_ERANGE = $46; 324 | LCB_SUBDOC_BAD_DELTA = $47; 325 | LCB_SUBDOC_PATH_EEXISTS = $48; 326 | LCB_SUBDOC_MULTI_FAILURE = $49; 327 | LCB_SUBDOC_VALUE_E2DEEP = $4A; 328 | LCB_EINVAL_MCD = $4B; 329 | LCB_EMPTY_PATH = $4C; 330 | LCB_UNKNOWN_SDCMD = $4D; 331 | LCB_ENO_COMMANDS = $4E; 332 | LCB_QUERY_ERROR = $4F; 333 | ``` 334 | 335 | ## Working with JSON Documents 336 | 337 | Couchbase offers special subdocument APIs designed specifically for manipulating JSON documents. These APIs operate in a slightly different manner than the RAW APIs and assume the content they are manipulating is valid JSON. 338 | 339 | For simplicity sake in Delphi we implement these APIs as an interface ```ICouchbaseSubDoc``` instead of an object class so that we execute operations without the need to destroy objects. In addition we created the ```ICouchbaseSubDoc``` interface so the result of the various methods are also ```ICouchbaseSubDoc``` so we can build cascading database transactions. 340 | 341 | For example, consider the following example JSON: 342 | 343 | ```javascript 344 | { 345 | "id": "0001", 346 | "type": "donut", 347 | "name": "Cake", 348 | "number": 1, 349 | "batters": 350 | { 351 | "batter": 352 | [ 353 | { "id": "1001", "type": "Regular" }, 354 | { "id": "1002", "type": "Chocolate" }, 355 | { "id": "1003", "type": "Blueberry" }, 356 | { "id": "1004", "type": "Devil's Food" } 357 | ] 358 | } 359 | } 360 | ``` 361 | 362 | ### To insert the JSON we would do the following... 363 | 364 | ```Delphi 365 | var 366 | CBResult: TCouchbaseResult; 367 | begin 368 | CBResult := FCouchbase.Upsert('Test', ExampleJson); 369 | end; 370 | ``` 371 | In the above example we called the ```Upsert``` method to insert or update the key called ```'Test'```with the example JSON above. 372 | 373 | ### To get a single value from a single name in the JSON we would do the following... 374 | 375 | ```Delphi 376 | var 377 | CBSubDocResult: TCouchbaseSubDocResult; 378 | begin 379 | CBSubDocResult := FCouchbase.LookupIn('Test').Get('type').Execute; 380 | if CBSubDocResult.Success then 381 | Writeln('type = ' + CBSubDocResult.Responses[0].Value); 382 | end; 383 | ``` 384 | In the above example we first call the special method ```Couchbase.LookupIn``` which is used for queries of subdocuments (read-only JSON operations) then we ask the key named ```'Test'``` and the JSON name called ```'type'```. 385 | 386 | If the subdocument transaction was successful, then ```CBSubDocResult.Success``` returns ```True``` and we receive a ```TArray```. It is important to check the Length of this array because transactions can succeed and yield 0 results. 387 | 388 | ### To get multiple values from a multiple names in the JSON we would do the following... 389 | 390 | ```Delphi 391 | var 392 | CBSubDocResult: TCouchbaseSubDocResult; 393 | begin 394 | CBSubDocResult := FCouchbase.LookupIn('Test').Get('type').Get('name').Execute; 395 | if CBSubDocResult.Success then 396 | begin 397 | Writeln('type = ' + CBSubDocResult.Responses[0].Value); 398 | Writeln('name = ' + CBSubDocResult.Responses[1].Value); 399 | end; 400 | end; 401 | ``` 402 | In the above example we create a cascading transaction of 2 distinct Get operations. The resulting ```TArray``` will have a Length of 2 with the respective values for the specified names. 403 | 404 | In this way we can cascade many different subdocument operations in a single transaction. These operations can be of any method that returns ```ICouchbaseSubDoc```. 405 | 406 | ### To insert a new name and value in the JSON we would do the following... 407 | ```Delphi 408 | var 409 | CBSubDocResult: TCouchbaseSubDocResult; 410 | begin 411 | CBSubDocResult := FCouchbase.MutateIn('Test').Upsert('frosting', '"pink"').Execute; 412 | end; 413 | ``` 414 | In the above example we call the special method ```Couchbase.MutateIn``` which is used for modifying subdocuments (write JSON operations) then we ask the key named ```'Test'```. The ```Upsert``` cascading operation inserts a new name called ```'frosting'``` and sets it's value to ```'pink'```. 415 | 416 | I think you probably get the idea by now. By combining cascading JSON operations into a single transaction you can perform relatively complex operations. 417 | 418 | ## JSON subdocument methods 419 | The following methods are cascading methods that are used in conjunction with the ```Couchbase.LookupIn``` and ```Couchbase.MutateIn``` methods. 420 | 421 | ### Get a JSON value 422 | To get a value for a given name in the JSON. 423 | ```Delphi 424 | var 425 | CBSubDocResult: TCouchbaseSubDocResult; 426 | begin 427 | CBSubDocResult := FCouchbase.LookupIn('Test').Get('type').Execute; 428 | end; 429 | ``` 430 | ### Get a JSON Array 431 | To get an entire JSON array from a given name in the JSON. 432 | ```Delphi 433 | var 434 | CBSubDocResult: TCouchbaseSubDocResult; 435 | begin 436 | CBSubDocResult := FCouchbase.LookupIn('Test').Get('batters').Execute; 437 | if CBSubDocResult.Success then 438 | Writeln(CBSubDocResult.Responses[0].Value); 439 | end; 440 | ``` 441 | The result ```CBSubDocResult.Responses[0].Value``` would be the JSON... 442 | ```javascript 443 | '{"batter":[{ "id": "1001", "type": "Regular" },{ "id": "1002", "type": "Chocolate" },{ "id": "1003", "type": "Blueberry" },{ "id": "1004", "type": "Devil''s Food" }]}' 444 | ``` 445 | 446 | ### Get the value of a JSON array element 447 | To get the JSON value assocated with a JSON array element. 448 | ```Delphi 449 | var 450 | CBSubDocResult: TCouchbaseSubDocResult; 451 | begin 452 | CBSubDocResult := FCouchbase.LookupIn('Test').Get('batters.batter[0]').Execute; 453 | end; 454 | ``` 455 | The result ```CBSubDocResult.Responses[0].Value``` would be the JSON... 456 | ```javascript 457 | '{ "id": "1001", "type": "Regular" }' 458 | ``` 459 | 460 | ### Get the value of a JSON array element value 461 | To get the value of a JSON array element value. 462 | ```Delphi 463 | var 464 | CBSubDocResult: TCouchbaseSubDocResult; 465 | begin 466 | CBSubDocResult := FCouchbase.LookupIn('Test').Get('batters.batter[0].id').Execute; 467 | end; 468 | ``` 469 | The result ```CBSubDocResult.Responses[0].Value``` would be the value ```"1001"```. 470 | 471 | ### To check whether a JSON name exists 472 | Checking for the existance of a name in the JSON. 473 | ```Delphi 474 | var 475 | CBSubDocResult: TCouchbaseSubDocResult; 476 | begin 477 | CBSubDocResult := FCouchbase.LookupIn('Test').Exists('number').Execute; 478 | if CBSubDocResult.Success then 479 | if CBSubDocResult.Responses[0].Status = LCB_SUCCESS then 480 | Writeln('The name "number" exists'); 481 | end; 482 | ``` 483 | The above example will return the result ```CBSubDocResult.Responses[0].Status``` of ```LCB_SUCCESS``` if the name exists. 484 | 485 | ### To get the number of elements of a JSON array 486 | To return the number of elements of a given JSON array. 487 | ```Delphi 488 | var 489 | CBSubDocResult: TCouchbaseSubDocResult; 490 | begin 491 | CBSubDocResult := FCouchbase.LookupIn('Test').GetCount('batters.batter').Execute; 492 | end; 493 | ``` 494 | 495 | > Note: The GetCount API does not appear to work correctly in the current pre-release 4.6 Couchbase Server in conjunction with the latest Couchbase APIs. 496 | 497 | ### To upsert a new name/value pair into the JSON 498 | ```Delphi 499 | var 500 | CBSubDocResult: TCouchbaseSubDocResult; 501 | begin 502 | CBSubDocResult := FCouchbase.MutateIn('Test').Upsert('frosting', '"pink"').Execute; 503 | end; 504 | ``` 505 | The above example will insert a new name called ```'frosting'``` into the JSON and set it's value to ```'pink'```. The ```Upsert``` method can also modify the existing value associated with a name. 506 | 507 | ### To insert a new name/value pair into the JSON 508 | ```Delphi 509 | var 510 | CBSubDocResult: TCouchbaseSubDocResult; 511 | begin 512 | CBSubDocResult := FCouchbase.MutateIn('Test').Insert('frosting', '"pink"').Execute; 513 | end; 514 | ``` 515 | The Insert method operates much like Upsert, but it will fail if you attempt to insert a name that already matches an existing name. In the case of failure ```CBSubDocResult.Success``` will return as ```False``` and ```CBSubDocResult.Responses[0].Status``` will return the status of ```LCB_SUBDOC_PATH_EEXISTS```. 516 | 517 | ### To replace the value associated with an existing name in the JSON 518 | ```Delphi 519 | var 520 | CBSubDocResult: TCouchbaseSubDocResult; 521 | begin 522 | CBSubDocResult := FCouchbase.MutateIn('Test').Replace('type', '"yummy"').Execute; 523 | end; 524 | ``` 525 | In the above example the name ```'type'``` has it's value changed to ```'yummy'```. 526 | 527 | ### To delete or remove an existing name and value from the JSON 528 | ```Delphi 529 | var 530 | CBSubDocResult: TCouchbaseSubDocResult; 531 | begin 532 | CBSubDocResult := FCouchbase.MutateIn('Test').Remove('type').Execute; 533 | end; 534 | ``` 535 | The above example will delete the name/value pair for ```'type'``` from the JSON. 536 | 537 | ### To append to an array in the JSON 538 | ```Delphi 539 | var 540 | CBSubDocResult: TCouchbaseSubDocResult; 541 | begin 542 | CBSubDocResult := FCouchbase.MutateIn('Test').ArrayAppend('batters.batter', '{ "id": "1005", "type": "Yummy" }').Execute; 543 | end; 544 | ``` 545 | The above example simply adds another element to the existing array called ```batters.batter``` in the JSON. By default the array will be created if it does not exist. You can override this behavior by setting the ```CreateParent``` parameter to ```False```. 546 | 547 | ### To prepend to an array in the JSON 548 | Prepending is the same as inserting into the array at the first position with the option of creating the array if it does not already exist. 549 | ```Delphi 550 | var 551 | CBSubDocResult: TCouchbaseSubDocResult; 552 | begin 553 | CBSubDocResult := FCouchbase.MutateIn('Test').ArrayPrepend('batters.batter', '{ "id": "1000", "type": "Cherry" }').Execute; 554 | end; 555 | ``` 556 | 557 | ### To add a unique value to a JSON array 558 | ```Delphi 559 | var 560 | CBSubDocResult: TCouchbaseSubDocResult; 561 | begin 562 | CBSubDocResult := FCouchbase.MutateIn('Test').ArrayAddUnique('batters.numbers', '42').Execute; 563 | end; 564 | ``` 565 | In the above example we create a new array under ```batters``` called ```numbers``` and we add the value ```'42'``` to the array. If we attempted to add it again ```CBSubDocResult.Success``` would return ```False``` and ```CBSubDocResult.Responses[0].Status``` would indicate the error code ```LCB_SUBDOC_PATH_EEXISTS```. 566 | 567 | ### To insert a value into an existing JSON array at a specific position 568 | To indicate the element position to insert into an existing array, you provide the element index. 569 | ```Delphi 570 | var 571 | CBSubDocResult: TCouchbaseSubDocResult; 572 | begin 573 | CBSubDocResult := FCouchbase.MutateIn('Test').ArrayInsert('batters.numbers[0]', '41').Execute; 574 | end; 575 | ``` 576 | You can also use ```[-1]``` as an index if you want to insert into the first position. 577 | 578 | ### To increment or decrement the value of a JSON name 579 | ```Delphi 580 | var 581 | CBSubDocResult: TCouchbaseSubDocResult; 582 | begin 583 | CBSubDocResult := FCouchbase.MutateIn('Test').Counter('Cost', '100').Execute; 584 | CBSubDocResult := FCouchbase.MutateIn('Test').Counter('Cost', '50').Execute; 585 | end; 586 | ``` 587 | In the above example, ```Cost``` will initially be set to the value ```100``` but after the second call to Counter ```Cost``` will become the value ```150```. You can use positive or negative numbers to increment or decrement respectively. 588 | 589 | Of course the above example could easily be written as... 590 | ```Delphi 591 | CBSubDocResult := FCouchbase.MutateIn('Test').Counter('Cost', '100').Counter('Cost', '50').Execute; 592 | ``` 593 | 594 | ## Creating content that expires 595 | Couchbase includes the concept of expiring content. If you want your content to delete automatically in the future you set the ExpireTime option when you insert or update the key. 596 | 597 | This can be useful when content is temporary, such as cache memory tables or session variables, for example. 598 | 599 | Consider the following example: 600 | ```Delphi 601 | var 602 | CBResult: TCouchbaseResult; 603 | CBOptions: TCouchbaseOptions; 604 | AValue: String; 605 | begin 606 | CBOptions.Initialize; 607 | CBOptions.ExpireTime := 1; 608 | CBResult := FCouchbase.Upsert('Expires', 'Something', CBOptions); 609 | if CBResult.Success then 610 | begin 611 | CBResult := FCouchbase.Get('Expires', AValue); 612 | // CBResult.Success will be True here 613 | Sleep(2000); 614 | CBResult := FCouchbase.Get('Expires', AValue); 615 | // CBResult.Success will be False here 616 | end; 617 | end; 618 | ``` 619 | In the above example we create a key called ```Expires``` that contains ```'Something'``` and we set the option so it expires in one second ```CBOptions.ExpireTime := 1```. Upon inserting the content and checking for success, the subsequent ```Get``` operation will succeed but after waiting 2 more seconds the ```Get``` operation will fail. You will also receive ```CBResult.Error = LCB_KEY_ENOENT``` because the key is no longer valid. 620 | 621 | To keep your content from expiring and thereby be deleted forever you can use the ```Touch``` method. This method simply updates the expiration time for the given key. 622 | ```Delphi 623 | var 624 | CBResult: TCouchbaseResult; 625 | begin 626 | CBResult := FCouchbase.Touch('Expires', 3); 627 | end; 628 | ``` 629 | In the above example we update the expiration to 3 seconds and restart the countdown. 630 | 631 | ## Querying Couchbase system statistics 632 | Internally Couchbase maintains various system statistics that relate to individual nodes and the overall system health. You can query this information ondemand by using the ```Stats``` method. 633 | 634 | ```Delphi 635 | var 636 | CBStatsResult: TCouchbaseStatsResult; 637 | begin 638 | CBStatsResult := FCouchbase.Stats; 639 | end; 640 | ``` 641 | The method returns a ```TCouchbaseStatsResult``` record. 642 | 643 | ```Delphi 644 | TCouchbaseStatsResult = record 645 | Success: Boolean; 646 | Error: Integer; 647 | Stats: TDictionary; 648 | Flags: Integer; 649 | CAS: Integer; 650 | Node: Utf8String; { flush/stat ops } 651 | public 652 | procedure Initialize; 653 | procedure Finalize; 654 | end; 655 | ``` 656 | 657 | The ```Stats``` method will return ```CouchbaseStatsResult.Success = True``` if the call succeeds. ```CouchbaseStatsResult.Stats``` is a Dictionary that contains a list of Stat keys and respective values. 658 | 659 | To iterate through the various keys you could do the following... 660 | ```Delphi 661 | var 662 | Key: Utf8String; 663 | begin 664 | for Key in CouchbaseStatsResult.Stats.Keys do 665 | Writeln(Format('%s %s=%s', [CouchbaseStatsResult.Node, Key, TEncoding.UTF8.GetString(CouchbaseStatsResult.Stats.Items[Key])])); 666 | end; 667 | 668 | ``` 669 | 670 | ## Database Querying with N1QL 671 | The folks at Couchbase created the [N1QL query language](https://www.couchbase.com/n1ql) so that developers could optionally create SQL like syntax for JSON documents. 672 | 673 | ```Delphi 674 | var 675 | CBQueryResult: TCouchbaseQueryResult; 676 | CBQuery: TgoCouchbaseN1QL; 677 | CBResult: TCouchbaseResult; 678 | begin 679 | CBQuery := TgoCouchbaseN1QL.Create; 680 | CBQuery.SetStatement('SELECT * FROM default USE KEYS ''Test'''); 681 | CBQueryResult := FCouchbase.Query(CBQuery); 682 | try 683 | if CBQueryResult.Success then 684 | begin 685 | if CBQueryResult.Metrics.ResultCount = 1 then 686 | Writeln(CBQueryResult.Rows[0]); 687 | end; 688 | finally 689 | CBQueryResult.Finalize; 690 | end; 691 | CBQuery.Free; 692 | end; 693 | ``` 694 | The ```Query``` method returns a ```TCouchbaseQueryResult``` and if ```Success``` is ```True``` the ```Metrics.ResultCount``` will contain the number of ```Rows``` returned. 695 | 696 | For an exhaustive look at the various possibilities and related meta data, see [Couchbase's documentation on N1QL](https://www.couchbase.com/n1ql). 697 | 698 | ## Unit tests 699 | We have included DUnit unit tests for the various APIs described in this document in the DelphiCouchbase repository on GitHub. 700 | 701 | To run the unit tests you need to modify the constant ```CONNECT_STRING``` in the ```TestCouchbase.pas``` source to contain your actual connection string. 702 | 703 | ```Delphi 704 | { Connect string for your Couchbase Server instance } 705 | CONNECT_STRING = 'couchbase://192.168.1.84'; 706 | ``` 707 | 708 | ## JSON class libraries 709 | This class uses the Grijjy JSON class libraries contained in the [Grijjy Foundation library](https://github.com/grijjy/GrijjyFoundation). 710 | 711 | ## Conclusion 712 | We hope you enjoy and find useful this base framework for using Couchbase in Delphi and you learn to love the wonderful NoSQL solution Couchbase. 713 | 714 | ## License 715 | TgoCouchbase and DelphiCouchbase is licensed under the Simplified BSD License. See License.txt for details. 716 | 717 | Grijjy is in no way affiliated with Couchbase. -------------------------------------------------------------------------------- /Tests/Bin/example.json: -------------------------------------------------------------------------------- 1 | {"id": "0001","type": "donut","name": "Cake","number": 1,"batters":{"batter":[{ "id": "1001", "type": "Regular" },{ "id": "1002", "type": "Chocolate" },{ "id": "1003", "type": "Blueberry" },{ "id": "1004", "type": "Devil's Food" }]}} -------------------------------------------------------------------------------- /Tests/Bin/libcouchbase.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grijjy/DelphiCouchbase/e080d73d997a1c17d1f1f4fa9163a1b28f780c9f/Tests/Bin/libcouchbase.dll -------------------------------------------------------------------------------- /Tests/Bin/query.json: -------------------------------------------------------------------------------- 1 | { 2 | "default": { 3 | "batters": { 4 | "batter": [ 5 | { 6 | "id": "1001", 7 | "type": "Regular" 8 | }, 9 | { 10 | "id": "1002", 11 | "type": "Chocolate" 12 | }, 13 | { 14 | "id": "1003", 15 | "type": "Blueberry" 16 | }, 17 | { 18 | "id": "1004", 19 | "type": "Devil's Food" 20 | } 21 | ] 22 | }, 23 | "id": "0001", 24 | "name": "Cake", 25 | "number": 1, 26 | "type": "donut" 27 | } 28 | } -------------------------------------------------------------------------------- /Tests/CouchbaseTests.dpr: -------------------------------------------------------------------------------- 1 | program CouchbaseTests; 2 | 3 | {$IFDEF CONSOLE_TESTRUNNER} 4 | {$APPTYPE CONSOLE} 5 | {$ENDIF} 6 | 7 | uses 8 | DUnitTestRunner, 9 | TestCouchbase in 'TestCouchbase.pas', 10 | Couchbase.API in '..\Couchbase.API.pas', 11 | Couchbase in '..\Couchbase.pas', 12 | Grijjy.Bson in '..\..\GrijjyFoundation\Grijjy.Bson.pas', 13 | Grijjy.SysUtils in '..\..\GrijjyFoundation\Grijjy.SysUtils.pas', 14 | Grijjy.DateUtils in '..\..\GrijjyFoundation\Grijjy.DateUtils.pas', 15 | Grijjy.Bson.IO in '..\..\GrijjyFoundation\Grijjy.Bson.IO.pas', 16 | Grijjy.BinaryCoding in '..\..\GrijjyFoundation\Grijjy.BinaryCoding.pas'; 17 | 18 | { R *.RES} 19 | 20 | begin 21 | DUnitTestRunner.RunRegisteredTests; 22 | end. 23 | 24 | -------------------------------------------------------------------------------- /Tests/CouchbaseTests.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {145CB9B2-003A-44C2-B14B-00BA2EAE4D70} 4 | 18.2 5 | None 6 | True 7 | Debug 8 | Win32 9 | 1 10 | Console 11 | CouchbaseTests.dpr 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Base 34 | true 35 | 36 | 37 | true 38 | Cfg_1 39 | true 40 | true 41 | 42 | 43 | true 44 | Base 45 | true 46 | 47 | 48 | CouchbaseTests 49 | System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) 50 | _CONSOLE_TESTRUNNER;$(DCC_Define) 51 | $(BDS)\Source\DUnit\src;$(DCC_UnitSearchPath) 52 | . 53 | .\$(Platform)\$(Config) 54 | false 55 | false 56 | false 57 | false 58 | false 59 | 60 | 61 | DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;tethering;fmxFireDAC;FireDAC;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;inetdb;soaprtl;DbxCommonDriver;FireDACIBDriver;fmx;fmxdae;xmlrtl;soapmidas;fmxobj;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) 62 | 63 | 64 | CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) 65 | DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;tethering;svnui;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;FireDAC;vcltouch;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;inetdb;soaprtl;DbxCommonDriver;CodeSiteLoggingPkg;FireDACIBDriver;fmx;fmxdae;xmlrtl;soapmidas;CodeSiteDBToolsPkg;fmxobj;vclwinx;rtl;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;FireDACCommon;IndyIPClient;EurekaLogCore;bindcompvcl;RESTBackendComponents;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;Grijjy.Package.RTL;FireDACCommonODBC;FireDACCommonDriver;Grijjy.Package.FMX;inet;fmxase;$(DCC_UsePackage) 66 | ZMQLOGGING;$(DCC_Define) 67 | (None) 68 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 69 | 1033 70 | 71 | 72 | DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;FireDAC;vcltouch;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;inetdb;soaprtl;DbxCommonDriver;FireDACIBDriver;fmx;fmxdae;xmlrtl;soapmidas;fmxobj;vclwinx;rtl;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) 73 | 74 | 75 | DEBUG;$(DCC_Define) 76 | true 77 | false 78 | true 79 | true 80 | true 81 | 82 | 83 | (None) 84 | 1033 85 | .\Bin 86 | false 87 | 88 | 89 | false 90 | RELEASE;$(DCC_Define) 91 | 0 92 | 0 93 | 94 | 95 | 96 | MainSource 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | Cfg_2 108 | Base 109 | 110 | 111 | Base 112 | 113 | 114 | Cfg_1 115 | Base 116 | 117 | 118 | 119 | Delphi.Personality.12 120 | Application 121 | 122 | 123 | 124 | CouchbaseTests.dpr 125 | 126 | 127 | Microsoft Office 2000 Sample Automation Server Wrapper Components 128 | Microsoft Office XP Sample Automation Server Wrapper Components 129 | 130 | 131 | 132 | 133 | 134 | true 135 | 136 | 137 | 138 | 139 | true 140 | 141 | 142 | 143 | 144 | true 145 | 146 | 147 | 148 | 149 | true 150 | 151 | 152 | 153 | 154 | CouchbaseTests.exe 155 | true 156 | 157 | 158 | 159 | 160 | 1 161 | 162 | 163 | 1 164 | 165 | 166 | 167 | 168 | Contents\Resources 169 | 1 170 | 171 | 172 | 173 | 174 | classes 175 | 1 176 | 177 | 178 | 179 | 180 | Contents\MacOS 181 | 0 182 | 183 | 184 | 1 185 | 186 | 187 | Contents\MacOS 188 | 1 189 | 190 | 191 | 192 | 193 | 1 194 | 195 | 196 | 1 197 | 198 | 199 | 1 200 | 201 | 202 | 203 | 204 | res\drawable-xxhdpi 205 | 1 206 | 207 | 208 | 209 | 210 | library\lib\mips 211 | 1 212 | 213 | 214 | 215 | 216 | 1 217 | 218 | 219 | 1 220 | 221 | 222 | 0 223 | 224 | 225 | 1 226 | 227 | 228 | Contents\MacOS 229 | 1 230 | 231 | 232 | library\lib\armeabi-v7a 233 | 1 234 | 235 | 236 | 1 237 | 238 | 239 | 240 | 241 | 0 242 | 243 | 244 | Contents\MacOS 245 | 1 246 | .framework 247 | 248 | 249 | 250 | 251 | 1 252 | 253 | 254 | 1 255 | 256 | 257 | 258 | 259 | 1 260 | 261 | 262 | 1 263 | 264 | 265 | 1 266 | 267 | 268 | 269 | 270 | 1 271 | 272 | 273 | 1 274 | 275 | 276 | 1 277 | 278 | 279 | 280 | 281 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 282 | 1 283 | 284 | 285 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 286 | 1 287 | 288 | 289 | 290 | 291 | 1 292 | 293 | 294 | 1 295 | 296 | 297 | 1 298 | 299 | 300 | 301 | 302 | 1 303 | 304 | 305 | 1 306 | 307 | 308 | 1 309 | 310 | 311 | 312 | 313 | library\lib\armeabi 314 | 1 315 | 316 | 317 | 318 | 319 | 0 320 | 321 | 322 | 1 323 | 324 | 325 | Contents\MacOS 326 | 1 327 | 328 | 329 | 330 | 331 | 1 332 | 333 | 334 | 1 335 | 336 | 337 | 1 338 | 339 | 340 | 341 | 342 | res\drawable-normal 343 | 1 344 | 345 | 346 | 347 | 348 | res\drawable-xhdpi 349 | 1 350 | 351 | 352 | 353 | 354 | res\drawable-large 355 | 1 356 | 357 | 358 | 359 | 360 | 1 361 | 362 | 363 | 1 364 | 365 | 366 | 1 367 | 368 | 369 | 370 | 371 | Assets 372 | 1 373 | 374 | 375 | Assets 376 | 1 377 | 378 | 379 | 380 | 381 | ..\ 382 | 1 383 | 384 | 385 | ..\ 386 | 1 387 | 388 | 389 | 390 | 391 | res\drawable-hdpi 392 | 1 393 | 394 | 395 | 396 | 397 | library\lib\armeabi-v7a 398 | 1 399 | 400 | 401 | 402 | 403 | Contents 404 | 1 405 | 406 | 407 | 408 | 409 | ..\ 410 | 1 411 | 412 | 413 | 414 | 415 | Assets 416 | 1 417 | 418 | 419 | Assets 420 | 1 421 | 422 | 423 | 424 | 425 | 1 426 | 427 | 428 | 1 429 | 430 | 431 | 1 432 | 433 | 434 | 435 | 436 | res\values 437 | 1 438 | 439 | 440 | 441 | 442 | res\drawable-small 443 | 1 444 | 445 | 446 | 447 | 448 | res\drawable 449 | 1 450 | 451 | 452 | 453 | 454 | 1 455 | 456 | 457 | 1 458 | 459 | 460 | 1 461 | 462 | 463 | 464 | 465 | 1 466 | 467 | 468 | 469 | 470 | res\drawable 471 | 1 472 | 473 | 474 | 475 | 476 | 0 477 | 478 | 479 | 0 480 | 481 | 482 | Contents\Resources\StartUp\ 483 | 0 484 | 485 | 486 | 0 487 | 488 | 489 | 0 490 | 491 | 492 | 0 493 | 494 | 495 | 496 | 497 | library\lib\armeabi-v7a 498 | 1 499 | 500 | 501 | 502 | 503 | 0 504 | .bpl 505 | 506 | 507 | 1 508 | .dylib 509 | 510 | 511 | Contents\MacOS 512 | 1 513 | .dylib 514 | 515 | 516 | 1 517 | .dylib 518 | 519 | 520 | 1 521 | .dylib 522 | 523 | 524 | 525 | 526 | res\drawable-mdpi 527 | 1 528 | 529 | 530 | 531 | 532 | res\drawable-xlarge 533 | 1 534 | 535 | 536 | 537 | 538 | res\drawable-ldpi 539 | 1 540 | 541 | 542 | 543 | 544 | 0 545 | .dll;.bpl 546 | 547 | 548 | 1 549 | .dylib 550 | 551 | 552 | Contents\MacOS 553 | 1 554 | .dylib 555 | 556 | 557 | 1 558 | .dylib 559 | 560 | 561 | 1 562 | .dylib 563 | 564 | 565 | 566 | 567 | 568 | 569 | 570 | 571 | 572 | 573 | 574 | 575 | False 576 | True 577 | False 578 | 579 | 580 | DUnit / Delphi Win32 581 | GUI 582 | C:\Grijjy\Projects\Research\Couchbase\HelloWorldExample.dproj 583 | 584 | 585 | 586 | 12 587 | 588 | 589 | 590 | 591 | 592 | -------------------------------------------------------------------------------- /Tests/CouchbaseTests.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/grijjy/DelphiCouchbase/e080d73d997a1c17d1f1f4fa9163a1b28f780c9f/Tests/CouchbaseTests.res -------------------------------------------------------------------------------- /Tests/TestCouchbase.pas: -------------------------------------------------------------------------------- 1 | unit TestCouchbase; 2 | 3 | interface 4 | 5 | uses 6 | TestFramework, 7 | SysUtils, 8 | IOUtils, 9 | Couchbase.API, 10 | Couchbase; 11 | 12 | const 13 | { Connect string for your Couchbase Server instance } 14 | CONNECT_STRING = 'couchbase://192.168.1.84'; 15 | 16 | type 17 | TestTgoCouchbase = class(TTestCase) 18 | strict private 19 | class var FCouchbase: TgoCouchbase; 20 | class var FExampleJson: String; 21 | class destructor Destroy; 22 | public 23 | class constructor Create; 24 | public 25 | procedure SetUp; override; 26 | procedure TearDown; override; 27 | published 28 | procedure TestConnect; 29 | 30 | { Json } 31 | procedure TestUpsertJson; 32 | procedure TestGetJson; 33 | procedure TestAddJson; 34 | procedure TestReplaceJson; 35 | procedure TestDeleteJson; 36 | 37 | { Raw Data } 38 | procedure TestUpsertData; 39 | procedure TestIncrData; 40 | procedure TestDecrData; 41 | procedure TestAppendData; 42 | procedure TestPrependData; 43 | 44 | { Other } 45 | procedure TestExpires; 46 | procedure TestTouch; 47 | procedure TestStats; 48 | 49 | { N1QL } 50 | procedure TestQuery; 51 | end; 52 | 53 | TestTgoCouchbaseSubDoc = class(TTestCase) 54 | strict private 55 | class var FCouchbase: TgoCouchbase; 56 | class var FExampleJson: String; 57 | class destructor Destroy; 58 | public 59 | class constructor Create; 60 | public 61 | procedure SetUp; override; 62 | procedure TearDown; override; 63 | published 64 | { LookupIn } 65 | procedure TestConnect; 66 | procedure TestSimpleGet; 67 | procedure TestGet2; 68 | procedure TestGetArray; 69 | procedure TestGetArrayElement; 70 | procedure TestGetArrayElementValue; 71 | procedure TestExists; 72 | procedure TestGetCount; 73 | 74 | { MutateIn } 75 | procedure TestUpsert; 76 | procedure TestInsert; 77 | procedure TestReplace; 78 | procedure TestRemove; 79 | procedure TestArrayAppend; 80 | procedure TestArrayPrepend; 81 | procedure TestArrayAddUnique; 82 | procedure TestArrayInsert; 83 | procedure TestCounter; 84 | end; 85 | 86 | implementation 87 | 88 | uses 89 | DateUtils; 90 | 91 | class constructor TestTgoCouchbase.Create; 92 | begin 93 | FCouchbase := TgoCouchbase.Create; 94 | FExampleJson := TFile.ReadAllText('example.json'); 95 | end; 96 | 97 | class destructor TestTgoCouchbase.Destroy; 98 | begin 99 | FCouchbase.Free; 100 | end; 101 | 102 | procedure TestTgoCouchbase.SetUp; 103 | begin 104 | inherited; 105 | end; 106 | 107 | procedure TestTgoCouchbase.TearDown; 108 | begin 109 | inherited; 110 | end; 111 | 112 | procedure TestTgoCouchbase.TestConnect; 113 | var 114 | ReturnValue: Boolean; 115 | begin 116 | ReturnValue := FCouchbase.Connect(CONNECT_STRING); 117 | CheckTrue(ReturnValue); 118 | CheckEquals(0, FCouchbase.LastErrorCode); 119 | end; 120 | 121 | procedure TestTgoCouchbase.TestUpsertJson; 122 | var 123 | CBResult: TCouchbaseResult; 124 | begin 125 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 126 | CheckTrue(CBResult.Success); 127 | end; 128 | 129 | procedure TestTgoCouchbase.TestGetJson; 130 | var 131 | CBResult: TCouchbaseResult; 132 | AValue: String; 133 | begin 134 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 135 | CheckTrue(CBResult.Success); 136 | CBResult := FCouchbase.Get('Test', AValue); 137 | CheckTrue(CBResult.Success); 138 | CheckEquals(Ord(TCouchbaseFormat.JSON), Ord(CBResult.Format)); 139 | CheckEquals(FExampleJson, AValue); 140 | end; 141 | 142 | procedure TestTgoCouchbase.TestAddJson; 143 | var 144 | CBResult: TCouchbaseResult; 145 | AValue: String; 146 | RandomKey: Utf8String; 147 | begin 148 | RandomKey := Utf8Encode(TGuid.NewGuid.ToString); 149 | CBResult := FCouchbase.Add(RandomKey, FExampleJson); 150 | CheckTrue(CBResult.Success); 151 | CBResult := FCouchbase.Get(RandomKey, AValue); 152 | CheckTrue(CBResult.Success); 153 | CheckEquals(Ord(TCouchbaseFormat.JSON), Ord(CBResult.Format)); 154 | CheckEquals(FExampleJson, AValue); 155 | CBResult := FCouchbase.Add(RandomKey, FExampleJson); { attempt again } 156 | CheckFalse(CBResult.Success); 157 | CheckEquals(LCB_KEY_EEXISTS, CBResult.Error); 158 | end; 159 | 160 | procedure TestTgoCouchbase.TestReplaceJson; 161 | var 162 | CBResult: TCouchbaseResult; 163 | AValue: String; 164 | begin 165 | CBResult := FCouchbase.Replace('Test', '{ "hello" : "world" }'); 166 | CheckTrue(CBResult.Success); 167 | CBResult := FCouchbase.Get('Test', AValue); 168 | CheckTrue(CBResult.Success); 169 | CheckEquals(Ord(TCouchbaseFormat.JSON), Ord(CBResult.Format)); 170 | CheckEquals('{ "hello" : "world" }', AValue); 171 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 172 | CheckTrue(CBResult.Success); 173 | CBResult := FCouchbase.Get('Test', AValue); 174 | CheckTrue(CBResult.Success); 175 | CheckEquals(Ord(TCouchbaseFormat.JSON), Ord(CBResult.Format)); 176 | CheckEquals(FExampleJson, AValue); 177 | end; 178 | 179 | procedure TestTgoCouchbase.TestDeleteJson; 180 | var 181 | CBResult: TCouchbaseResult; 182 | AValue: String; 183 | begin 184 | CBResult := FCouchbase.Delete('Test'); 185 | CheckTrue(CBResult.Success); 186 | CBResult := FCouchbase.Get('Test', AValue); 187 | CheckFalse(CBResult.Success); 188 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 189 | CheckTrue(CBResult.Success); 190 | end; 191 | 192 | procedure TestTgoCouchbase.TestUpsertData; 193 | var 194 | CBResult: TCouchbaseResult; 195 | CBOptions: TCouchbaseOptions; 196 | AValue: String; 197 | begin 198 | CBOptions.Initialize; 199 | CBOptions.Format := TCouchbaseFormat.RAW; 200 | CBResult := FCouchbase.Upsert('Value', '1', CBOptions); 201 | CheckTrue(CBResult.Success); 202 | CBResult := FCouchbase.Get('Value', AValue); 203 | CheckTrue(CBResult.Success); 204 | CheckEquals(Ord(TCouchbaseFormat.RAW), Ord(CBResult.Format)); 205 | CheckEquals('1', AValue); 206 | end; 207 | 208 | procedure TestTgoCouchbase.TestIncrData; 209 | var 210 | CBResult: TCouchbaseResult; 211 | CBOptions: TCouchbaseOptions; 212 | AValue: String; 213 | begin 214 | CBOptions.Initialize; 215 | CBOptions.Format := TCouchbaseFormat.RAW; 216 | CBResult := FCouchbase.Upsert('Value', '1', CBOptions); 217 | CheckTrue(CBResult.Success); 218 | CBResult := FCouchbase.Incr('Value'); 219 | CheckTrue(CBResult.Success); 220 | CBResult := FCouchbase.Get('Value', AValue); 221 | CheckTrue(CBResult.Success); 222 | CheckEquals('2', AValue); 223 | end; 224 | 225 | procedure TestTgoCouchbase.TestDecrData; 226 | var 227 | CBResult: TCouchbaseResult; 228 | CBOptions: TCouchbaseOptions; 229 | AValue: String; 230 | begin 231 | CBOptions.Initialize; 232 | CBOptions.Format := TCouchbaseFormat.RAW; 233 | CBResult := FCouchbase.Upsert('Value', '2', CBOptions); 234 | CheckTrue(CBResult.Success); 235 | CBResult := FCouchbase.Decr('Value'); 236 | CheckTrue(CBResult.Success); 237 | CBResult := FCouchbase.Get('Value', AValue); 238 | CheckTrue(CBResult.Success); 239 | CheckEquals('1', AValue); 240 | end; 241 | 242 | procedure TestTgoCouchbase.TestAppendData; 243 | var 244 | CBResult: TCouchbaseResult; 245 | CBOptions: TCouchbaseOptions; 246 | AValue: String; 247 | begin 248 | CBOptions.Initialize; 249 | CBOptions.Format := TCouchbaseFormat.RAW; 250 | CBResult := FCouchbase.Upsert('Value', '1', CBOptions); 251 | CheckTrue(CBResult.Success); 252 | CBResult := FCouchbase.Append('Value', 'DEF'); 253 | CheckTrue(CBResult.Success); 254 | CBResult := FCouchbase.Get('Value', AValue); 255 | CheckTrue(CBResult.Success); 256 | CheckEquals('1DEF', AValue); 257 | end; 258 | 259 | procedure TestTgoCouchbase.TestPrependData; 260 | var 261 | CBResult: TCouchbaseResult; 262 | CBOptions: TCouchbaseOptions; 263 | AValue: String; 264 | begin 265 | CBOptions.Initialize; 266 | CBOptions.Format := TCouchbaseFormat.RAW; 267 | CBResult := FCouchbase.Upsert('Value', '1', CBOptions); 268 | CheckTrue(CBResult.Success); 269 | CBResult := FCouchbase.Prepend('Value', 'ABC'); 270 | CheckTrue(CBResult.Success); 271 | CBResult := FCouchbase.Get('Value', AValue); 272 | CheckTrue(CBResult.Success); 273 | CheckEquals('ABC1', AValue); 274 | end; 275 | 276 | procedure TestTgoCouchbase.TestExpires; 277 | var 278 | CBResult: TCouchbaseResult; 279 | CBOptions: TCouchbaseOptions; 280 | AValue: String; 281 | begin 282 | CBOptions.Initialize; 283 | CBOptions.ExpireTime := 1; 284 | CBResult := FCouchbase.Upsert('Expires', FExampleJson, CBOptions); 285 | CheckTrue(CBResult.Success); 286 | CBResult := FCouchbase.Get('Expires', AValue); 287 | CheckTrue(CBResult.Success); 288 | Sleep(2000); 289 | CBResult := FCouchbase.Get('Expires', AValue); 290 | CheckFalse(CBResult.Success); 291 | CheckEquals(LCB_KEY_ENOENT, CBResult.Error); 292 | end; 293 | 294 | procedure TestTgoCouchbase.TestTouch; 295 | var 296 | CBResult: TCouchbaseResult; 297 | CBOptions: TCouchbaseOptions; 298 | AValue: String; 299 | Start: TDateTime; 300 | begin 301 | CBOptions.Initialize; 302 | CBOptions.ExpireTime := 3; 303 | CBResult := FCouchbase.Upsert('Expires', FExampleJson, CBOptions); 304 | CheckTrue(CBResult.Success); 305 | CBResult := FCouchbase.Get('Expires', AValue); 306 | CheckTrue(CBResult.Success); 307 | Start := Now; 308 | while SecondsBetween(Now, Start) < 5 do 309 | begin 310 | CBResult := FCouchbase.Touch('Expires', 3); { keep alive } 311 | CheckTrue(CBResult.Success); 312 | Sleep(1000); 313 | end; 314 | Sleep(4000); 315 | CBResult := FCouchbase.Get('Expires', AValue); 316 | CheckFalse(CBResult.Success); 317 | CheckEquals(LCB_KEY_ENOENT, CBResult.Error); 318 | end; 319 | 320 | procedure TestTgoCouchbase.TestStats; 321 | var 322 | CBStatsResult: TCouchbaseStatsResult; 323 | begin 324 | CBStatsResult := FCouchbase.Stats; 325 | try 326 | CheckTrue(CBStatsResult.Success); 327 | CheckTrue(CBStatsResult.Stats.ContainsKey('ep_alog_path')); 328 | finally 329 | CBStatsResult.Finalize; 330 | end; 331 | end; 332 | 333 | procedure TestTgoCouchbase.TestQuery; 334 | var 335 | CBQueryResult: TCouchbaseQueryResult; 336 | CBQuery: TgoCouchbaseN1QL; 337 | CBResult: TCouchbaseResult; 338 | begin 339 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 340 | CheckTrue(CBResult.Success); 341 | CBQuery := TgoCouchbaseN1QL.Create; 342 | CBQuery.SetStatement('SELECT * FROM default USE KEYS ''Test'''); 343 | CBQueryResult := FCouchbase.Query(CBQuery); 344 | CheckTrue(CBQueryResult.Success); 345 | CheckEquals(1, CBQueryResult.Metrics.ResultCount); 346 | CheckEquals(TFile.ReadAllText('query.json'), CBQueryResult.Rows[0]); 347 | CBQueryResult.Finalize; 348 | CBQuery.Free; 349 | end; 350 | 351 | { TestTCouchbaseSubDoc } 352 | 353 | class constructor TestTgoCouchbaseSubDoc.Create; 354 | begin 355 | FCouchbase := TgoCouchbase.Create; 356 | FExampleJson := TFile.ReadAllText('example.json'); 357 | end; 358 | 359 | class destructor TestTgoCouchbaseSubDoc.Destroy; 360 | begin 361 | FCouchbase.Free; 362 | end; 363 | 364 | procedure TestTgoCouchbaseSubDoc.SetUp; 365 | begin 366 | inherited; 367 | end; 368 | 369 | procedure TestTgoCouchbaseSubDoc.TearDown; 370 | begin 371 | inherited; 372 | end; 373 | 374 | procedure TestTgoCouchbaseSubDoc.TestConnect; 375 | var 376 | ReturnValue: Boolean; 377 | begin 378 | ReturnValue := FCouchbase.Connect(CONNECT_STRING); 379 | CheckTrue(ReturnValue); 380 | CheckEquals(0, FCouchbase.LastErrorCode); 381 | end; 382 | 383 | procedure TestTgoCouchbaseSubDoc.TestSimpleGet; 384 | var 385 | CBResult: TCouchbaseResult; 386 | CBSubDocResult: TCouchbaseSubDocResult; 387 | begin 388 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 389 | CheckTrue(CBResult.Success); 390 | 391 | CBSubDocResult := FCouchbase.LookupIn('Test').Get('type').Execute; 392 | CheckTrue(CBSubDocResult.Success); 393 | CheckEquals(1, Length(CBSubDocResult.Responses)); 394 | CheckEquals('"donut"', CBSubDocResult.Responses[0].Value); 395 | end; 396 | 397 | procedure TestTgoCouchbaseSubDoc.TestGet2; 398 | var 399 | CBResult: TCouchbaseResult; 400 | CBSubDocResult: TCouchbaseSubDocResult; 401 | begin 402 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 403 | CheckTrue(CBResult.Success); 404 | 405 | CBSubDocResult := FCouchbase.LookupIn('Test').Get('type').Get('name').Execute; 406 | CheckTrue(CBSubDocResult.Success); 407 | CheckEquals(2, Length(CBSubDocResult.Responses)); 408 | CheckEquals('"donut"', CBSubDocResult.Responses[0].Value); 409 | CheckEquals('"Cake"', CBSubDocResult.Responses[1].Value); 410 | end; 411 | 412 | procedure TestTgoCouchbaseSubDoc.TestGetArray; 413 | var 414 | CBResult: TCouchbaseResult; 415 | CBSubDocResult: TCouchbaseSubDocResult; 416 | begin 417 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 418 | CheckTrue(CBResult.Success); 419 | 420 | CBSubDocResult := FCouchbase.LookupIn('Test').Get('batters').Execute; 421 | CheckTrue(CBSubDocResult.Success); 422 | CheckEquals(1, Length(CBSubDocResult.Responses)); 423 | CheckEquals('{"batter":[{ "id": "1001", "type": "Regular" },{ "id": "1002", "type": "Chocolate" },{ "id": "1003", "type": "Blueberry" },{ "id": "1004", "type": "Devil''s Food" }]}', CBSubDocResult.Responses[0].Value); 424 | end; 425 | 426 | procedure TestTgoCouchbaseSubDoc.TestGetArrayElement; 427 | var 428 | CBResult: TCouchbaseResult; 429 | CBSubDocResult: TCouchbaseSubDocResult; 430 | begin 431 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 432 | CheckTrue(CBResult.Success); 433 | 434 | CBSubDocResult := FCouchbase.LookupIn('Test').Get('batters.batter[0]').Execute; 435 | CheckTrue(CBSubDocResult.Success); 436 | CheckEquals(1, Length(CBSubDocResult.Responses)); 437 | CheckEquals('{ "id": "1001", "type": "Regular" }', CBSubDocResult.Responses[0].Value); 438 | end; 439 | 440 | procedure TestTgoCouchbaseSubDoc.TestGetArrayElementValue; 441 | var 442 | CBResult: TCouchbaseResult; 443 | CBSubDocResult: TCouchbaseSubDocResult; 444 | begin 445 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 446 | CheckTrue(CBResult.Success); 447 | 448 | CBSubDocResult := FCouchbase.LookupIn('Test').Get('batters.batter[0].id').Execute; 449 | CheckTrue(CBSubDocResult.Success); 450 | CheckEquals(1, Length(CBSubDocResult.Responses)); 451 | CheckEquals('"1001"', CBSubDocResult.Responses[0].Value); 452 | end; 453 | 454 | procedure TestTgoCouchbaseSubDoc.TestExists; 455 | var 456 | CBResult: TCouchbaseResult; 457 | CBSubDocResult: TCouchbaseSubDocResult; 458 | begin 459 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 460 | CheckTrue(CBResult.Success); 461 | 462 | CBSubDocResult := FCouchbase.LookupIn('Test').Exists('number').Execute; 463 | CheckTrue(CBSubDocResult.Success); 464 | CheckEquals(1, Length(CBSubDocResult.Responses)); 465 | CheckEquals(LCB_SUCCESS, CBSubDocResult.Responses[0].Status); 466 | 467 | CBSubDocResult := FCouchbase.LookupIn('Test').Exists('something').Execute; 468 | CheckFalse(CBSubDocResult.Success); 469 | CheckEquals(LCB_SUBDOC_MULTI_FAILURE, CBSubDocResult.Error); 470 | CheckEquals(1, Length(CBSubDocResult.Responses)); 471 | CheckEquals(LCB_SUBDOC_PATH_ENOENT, CBSubDocResult.Responses[0].Status); 472 | end; 473 | 474 | procedure TestTgoCouchbaseSubDoc.TestGetCount; 475 | var 476 | CBResult: TCouchbaseResult; 477 | CBSubDocResult: TCouchbaseSubDocResult; 478 | begin 479 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 480 | CheckTrue(CBResult.Success); 481 | 482 | CBSubDocResult := FCouchbase.LookupIn('Test').GetCount('batters.batter').Execute; // this API does not work? 483 | CheckTrue(CBSubDocResult.Success); 484 | CheckEquals(1, Length(CBSubDocResult.Responses)); 485 | end; 486 | 487 | procedure TestTgoCouchbaseSubDoc.TestUpsert; 488 | var 489 | CBResult: TCouchbaseResult; 490 | CBSubDocResult: TCouchbaseSubDocResult; 491 | begin 492 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 493 | CheckTrue(CBResult.Success); 494 | 495 | CBSubDocResult := FCouchbase.MutateIn('Test').Upsert('frosting', '"pink"').Execute; 496 | CheckTrue(CBSubDocResult.Success); 497 | CheckEquals(1, Length(CBSubDocResult.Responses)); 498 | 499 | CBSubDocResult := FCouchbase.LookupIn('Test').Get('frosting').Execute; 500 | CheckTrue(CBSubDocResult.Success); 501 | CheckEquals(1, Length(CBSubDocResult.Responses)); 502 | CheckEquals('"pink"', CBSubDocResult.Responses[0].Value); 503 | end; 504 | 505 | procedure TestTgoCouchbaseSubDoc.TestInsert; 506 | var 507 | CBResult: TCouchbaseResult; 508 | CBSubDocResult: TCouchbaseSubDocResult; 509 | begin 510 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 511 | CheckTrue(CBResult.Success); 512 | 513 | CBSubDocResult := FCouchbase.MutateIn('Test').Insert('frosting', '"pink"').Execute; 514 | CheckTrue(CBSubDocResult.Success); 515 | CheckEquals(1, Length(CBSubDocResult.Responses)); 516 | 517 | CBSubDocResult := FCouchbase.LookupIn('Test').Get('frosting').Execute; 518 | CheckTrue(CBSubDocResult.Success); 519 | CheckEquals(1, Length(CBSubDocResult.Responses)); 520 | CheckEquals('"pink"', CBSubDocResult.Responses[0].Value); 521 | 522 | { insert again } 523 | CBSubDocResult := FCouchbase.MutateIn('Test').Insert('frosting', '"pink"').Execute; 524 | CheckFalse(CBSubDocResult.Success); 525 | CheckEquals(1, Length(CBSubDocResult.Responses)); 526 | CheckEquals(LCB_SUBDOC_PATH_EEXISTS, CBSubDocResult.Responses[0].Status); 527 | end; 528 | 529 | procedure TestTgoCouchbaseSubDoc.TestReplace; 530 | var 531 | CBResult: TCouchbaseResult; 532 | CBSubDocResult: TCouchbaseSubDocResult; 533 | begin 534 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 535 | CheckTrue(CBResult.Success); 536 | 537 | CBSubDocResult := FCouchbase.MutateIn('Test').Replace('type', '"yummy"').Execute; 538 | CheckTrue(CBSubDocResult.Success); 539 | CheckEquals(1, Length(CBSubDocResult.Responses)); 540 | 541 | CBSubDocResult := FCouchbase.LookupIn('Test').Get('type').Execute; 542 | CheckTrue(CBSubDocResult.Success); 543 | CheckEquals(1, Length(CBSubDocResult.Responses)); 544 | CheckEquals('"yummy"', CBSubDocResult.Responses[0].Value); 545 | end; 546 | 547 | procedure TestTgoCouchbaseSubDoc.TestRemove; 548 | var 549 | CBResult: TCouchbaseResult; 550 | CBSubDocResult: TCouchbaseSubDocResult; 551 | begin 552 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 553 | CheckTrue(CBResult.Success); 554 | 555 | CBSubDocResult := FCouchbase.MutateIn('Test').Remove('type').Execute; 556 | CheckTrue(CBSubDocResult.Success); 557 | CheckEquals(1, Length(CBSubDocResult.Responses)); 558 | 559 | CBSubDocResult := FCouchbase.LookupIn('Test').Get('type').Execute; 560 | CheckFalse(CBSubDocResult.Success); 561 | CheckEquals(1, Length(CBSubDocResult.Responses)); 562 | CheckEquals(LCB_SUBDOC_PATH_ENOENT, CBSubDocResult.Responses[0].Status); 563 | end; 564 | 565 | procedure TestTgoCouchbaseSubDoc.TestArrayAppend; 566 | var 567 | CBResult: TCouchbaseResult; 568 | CBSubDocResult: TCouchbaseSubDocResult; 569 | begin 570 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 571 | CheckTrue(CBResult.Success); 572 | 573 | CBSubDocResult := FCouchbase.MutateIn('Test').ArrayAppend('batters.batter', '{ "id": "1005", "type": "Yummy" }').Execute; 574 | CheckTrue(CBSubDocResult.Success); 575 | CheckEquals(1, Length(CBSubDocResult.Responses)); 576 | 577 | CBSubDocResult := FCouchbase.LookupIn('Test').Get('batters.batter[-1]').Execute; 578 | CheckTrue(CBSubDocResult.Success); 579 | CheckEquals(1, Length(CBSubDocResult.Responses)); 580 | CheckEquals('{ "id": "1005", "type": "Yummy" }', CBSubDocResult.Responses[0].Value); 581 | end; 582 | 583 | procedure TestTgoCouchbaseSubDoc.TestArrayPrepend; 584 | var 585 | CBResult: TCouchbaseResult; 586 | CBSubDocResult: TCouchbaseSubDocResult; 587 | begin 588 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 589 | CheckTrue(CBResult.Success); 590 | 591 | CBSubDocResult := FCouchbase.MutateIn('Test').ArrayPrepend('batters.batter', '{ "id": "1000", "type": "Cherry" }').Execute; 592 | CheckTrue(CBSubDocResult.Success); 593 | CheckEquals(1, Length(CBSubDocResult.Responses)); 594 | 595 | CBSubDocResult := FCouchbase.LookupIn('Test').Get('batters.batter[0]').Execute; 596 | CheckTrue(CBSubDocResult.Success); 597 | CheckEquals(1, Length(CBSubDocResult.Responses)); 598 | CheckEquals('{ "id": "1000", "type": "Cherry" }', CBSubDocResult.Responses[0].Value); 599 | end; 600 | 601 | procedure TestTgoCouchbaseSubDoc.TestArrayAddUnique; 602 | var 603 | CBResult: TCouchbaseResult; 604 | CBSubDocResult: TCouchbaseSubDocResult; 605 | begin 606 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 607 | CheckTrue(CBResult.Success); 608 | 609 | CBSubDocResult := FCouchbase.MutateIn('Test').ArrayAddUnique('batters.numbers', '42').Execute; 610 | CheckTrue(CBSubDocResult.Success); 611 | CheckEquals(1, Length(CBSubDocResult.Responses)); 612 | 613 | { try to add it again } 614 | CBSubDocResult := FCouchbase.MutateIn('Test').ArrayAddUnique('batters.numbers', '42').Execute; 615 | CheckFalse(CBSubDocResult.Success); 616 | CheckEquals(1, Length(CBSubDocResult.Responses)); 617 | CheckEquals(LCB_SUBDOC_PATH_EEXISTS, CBSubDocResult.Responses[0].Status); 618 | end; 619 | 620 | procedure TestTgoCouchbaseSubDoc.TestArrayInsert; 621 | var 622 | CBResult: TCouchbaseResult; 623 | CBSubDocResult: TCouchbaseSubDocResult; 624 | begin 625 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 626 | CheckTrue(CBResult.Success); 627 | 628 | CBSubDocResult := FCouchbase.MutateIn('Test').ArrayAddUnique('batters.numbers', '42').Execute; 629 | CheckTrue(CBSubDocResult.Success); 630 | CheckEquals(1, Length(CBSubDocResult.Responses)); 631 | 632 | CBSubDocResult := FCouchbase.MutateIn('Test').ArrayInsert('batters.numbers[0]', '41').Execute; 633 | CheckTrue(CBSubDocResult.Success); 634 | CheckEquals(1, Length(CBSubDocResult.Responses)); 635 | 636 | CBSubDocResult := FCouchbase.LookupIn('Test').Get('batters.numbers[-1]').Execute; 637 | CheckTrue(CBSubDocResult.Success); 638 | CheckEquals(1, Length(CBSubDocResult.Responses)); 639 | CheckEquals('42', CBSubDocResult.Responses[0].Value); 640 | end; 641 | 642 | procedure TestTgoCouchbaseSubDoc.TestCounter; 643 | var 644 | CBResult: TCouchbaseResult; 645 | CBSubDocResult: TCouchbaseSubDocResult; 646 | begin 647 | CBResult := FCouchbase.Upsert('Test', FExampleJson); 648 | CheckTrue(CBResult.Success); 649 | 650 | CBSubDocResult := FCouchbase.MutateIn('Test').Counter('Cost', '100').Execute; 651 | CheckTrue(CBSubDocResult.Success); 652 | 653 | CBSubDocResult := FCouchbase.LookupIn('Test').Get('Cost').Execute; 654 | CheckTrue(CBSubDocResult.Success); 655 | CheckEquals(1, Length(CBSubDocResult.Responses)); 656 | CheckEquals('100', CBSubDocResult.Responses[0].Value); 657 | 658 | CBSubDocResult := FCouchbase.MutateIn('Test').Counter('Cost', '50').Execute; 659 | CheckTrue(CBSubDocResult.Success); 660 | CheckEquals(1, Length(CBSubDocResult.Responses)); 661 | 662 | CBSubDocResult := FCouchbase.LookupIn('Test').Get('Cost').Execute; 663 | CheckTrue(CBSubDocResult.Success); 664 | CheckEquals(1, Length(CBSubDocResult.Responses)); 665 | CheckEquals('150', CBSubDocResult.Responses[0].Value); 666 | end; 667 | 668 | initialization 669 | RegisterTest(TestTgoCouchbase.Suite); 670 | RegisterTest(TestTgoCouchbaseSubDoc.Suite); 671 | 672 | end. 673 | --------------------------------------------------------------------------------