Coverage report: /development/source/library/org/datagraph/spocq-shard/src/store/rlmdb/rlmdb-classes.lisp

KindCoveredAll%
expression256974 26.3
branch1456 25.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.rdf.lmdb.implementation; -*-
2
 
3
 (in-package :org.datagraph.rdf.lmdb.implementation)
4
 
5
 (:documentation "LMDB storage implementation
6
  The rlmdb:repository extends lmdb:repository and rlmdb:transaction does the same
7
  for lmdb:transaction.
8
  The respective specializations combine to index terms in various ways and to
9
  provide various ways to interpret the transaction history.
10
  with 
11
  Serves as delegate for Dydra repositories, which are stored as a complement of
12
  databases in an LMDB environment.
13
  ")
14
 
15
 ;;; database classes
16
    
17
 (defclass rlmdb:database (lmdb:database)
18
   ((repository :initarg :repository :type rlmdb:repository
19
                :reader database-repository))
20
   (:documentation
21
    "The root database class is internal.
22
    It just binds a reference to its repository"))
23
 
24
 
25
 (defclass metadata-database (rlmdb::database)
26
   ()
27
   (:documentation
28
    "metadata databases store data about the database - its class, transaction
29
    and/or revision history, ..."))
30
 
31
 (defclass rlmdb:meta-database (metadata-database)
32
   ()
33
   (:documentation "Specialization for current metadata database"))
34
 (defclass rlmdb:revision-ordinal-database (metadata-database)
35
   ()
36
   (:documentation "Specialization for uuid->ordinal database"))
37
 (defclass rlmdb:revision-record-database (metadata-database)
38
   ()
39
   (:documentation "Specialization for ordinal->record database"))
40
 
41
 
42
 (defclass rlmdb:index-database (rlmdb::database)
43
   ((names
44
     :reader index-database-names)))
45
 
46
 
47
 (defclass rlmdb:revision-sequence-database (database)
48
   ())
49
 
50
 
51
 ;;; specialize index databases according to sort operator and index entry
52
 
53
 (defclass rlmdb::uniform-predicate-index-database (rlmdb:index-database)
54
   ((key-map
55
     :initarg :key-map
56
     :reader index-database-key-map
57
     :documentation "The map specifies the position of term for the respective
58
      sort precedence")
59
    (key-maps
60
     :reader index-database-key-maps))
61
   (:documentation
62
    "Each database orders its keys according to its term precedence."))
63
    
64
 (defclass rlmdb::uniform-key-index-database (rlmdb:index-database)
65
    ((predicate
66
      :initarg :predicate
67
      :reader index-database-predicate
68
      :documentation "The predicate compares two statement records according to
69
      the database's term precedence as indicated in the respective term map.")
70
     (index-database-predicates
71
      :reader index-database-predicates))
72
   (:documentation
73
    "Each database incorporates a predicate to compare keys according to its term precedence."))
74
 
75
 (defclass rlmdb::null-record-database (rlmdb::index-database)
76
   ()
77
   (:documentation
78
    " A NULL-RECORD-DATABASE records keys, but no record content: all index data are zero length.
79
     nb: as lmdb delegates [put](https://github.com/LMDB/lmdb/blob/mdb.master/libraries/liblmdb/mdb.c#L7955)
80
     to memcpy, for which the [behaviour](https://stackoverflow.com/questions/5243012/is-it-guaranteed-to-be-safe-to-perform-memcpy0-0-0)
81
     for null arguments is undefined, a pointer is always to be passed, but the data length is held to zero."))
82
 
83
 (defclass rlmdb::ordinal-record-database (rlmdb::index-database)
84
   ()
85
   (:documentation
86
    "All index data are revision ordinal insert/delete indices."))
87
 
88
 (defclass rlmdb::replication-record-database (rlmdb::index-database)
89
   ()
90
   (:documentation
91
    "All index data are replication identifier insert/delete indices."))
92
 
93
 
94
 (eval-when (:compile-toplevel :load-toplevel :execute)
95
 
96
 (defgeneric quad-pattern-key-map-index (quad)
97
   (:method ((quad spocq:quad))
98
     (aref +quad-pattern-mask-index+
99
           (+ (case (spocq:quad-graph quad)
100
                ((|urn:dydra|:|named| |urn:dydra|:|all| nil) 0)
101
                (t 8))
102
              (if (spocq:quad-subject quad) 4 0)
103
              (if (spocq:quad-predicate quad) 2 0)
104
              (if (spocq:quad-object quad) 1 0))))
105
   (:method ((quad vector))
106
     (aref +quad-pattern-mask-index+
107
           (+ (case (aref quad 0) ((0 -2) 0) (t 8))  ;; can be a graph term number list
108
              (if (zerop (aref quad 1)) 0 4)
109
              (if (zerop (aref quad 2)) 0 2)
110
              (if (zerop (aref quad 3)) 0 1)))))
111
 
112
 (flet ((quad-predicate-lambda (name order)
113
          "Storage is always g.s.p.o and tests are arranged to sort with different precedence"
114
          `(lambda (%lhs %rhs)
115
             (block ,name
116
               (let ((%lhs-quad (cffi:foreign-slot-value %lhs '(:struct liblmdb:val) 'liblmdb:mv-data))
117
                     (%rhs-quad (cffi:foreign-slot-value %rhs '(:struct liblmdb:val) 'liblmdb:mv-data)))
118
                 (declare (dynamic-extent %lhs-quad %rhs-quad))
119
                 (flet ((cmp (i)
120
                          (let ((lhs_i (cffi:mem-aref %lhs-quad 'term-id i))
121
                                (rhs_i (cffi:mem-aref %rhs-quad 'term-id i)))
122
                            (cond ((< lhs_i rhs_i)
123
                                   (return-from ,name -1))
124
                                  ((> lhs_i rhs_i)
125
                                   (return-from ,name 1))))))
126
                   (declare (inline cmp))
127
                   (cmp ,(aref order 0))
128
                   (cmp ,(aref order 1))
129
                   (cmp ,(aref order 2))
130
                   (cmp ,(aref order 3))
131
                   0))))))
132
   (defparameter +quad-key-predicates+
133
     (apply #'vector (loop for db-name in +quad-database-names+
134
                       for db-key-order across +quad-key-maps+
135
                       for predicate-name = (cons-symbol :rlmdb :%compare-quad- db-name)
136
                       collect (compile predicate-name (quad-predicate-lambda predicate-name db-key-order))))))
137
 (macrolet ((def-quad-predicates (db-names)
138
              `(progn ,@(loop for db-name in db-names
139
                          for predicate-name = (cons-symbol :rlmdb :%compare-quad- db-name)
140
                          collect `(cffi:defcallback ,predicate-name :int ((lhs :pointer) (rhs :pointer))
141
                                     (,predicate-name lhs rhs))))))
142
   (def-quad-predicates #.+quad-database-names+))
143
 
144
 (defgeneric quad-pattern-key-map (quad)
145
   (:method ((name string))
146
     (aref +quad-key-maps+ (position name +quad-database-names+ :test #'string-equal)))
147
   (:method ((quad t))
148
     (aref +quad-key-maps+ (quad-pattern-key-map-index quad))))
149
 
150
 (defun quad-database-key-predicate (name)
151
   (aref +quad-key-predicates+ (position name +quad-database-names+ :test #'string-equal)))
152
 
153
 
154
 (defgeneric temporal-pattern-key-map-index (quad)
155
   (:method ((quad spocq:quad))
156
     (aref +temporal-pattern-mask-index+
157
           (+ (case (spocq:quad-graph quad)
158
                ((|urn:dydra|:|named| |urn:dydra|:|all| nil) 0)
159
                (t 4))
160
              (if (spocq:quad-subject quad) 2 0)
161
              (if (spocq:quad-predicate quad) 1 0))))
162
   (:method ((quad vector))
163
     (aref +temporal-pattern-mask-index+
164
           (+ (case (aref quad 0) ((0 -2) 0) (t 4))  ;; can be a graph term number list
165
              (if (zerop (aref quad 1)) 0 4)
166
              (if (zerop (aref quad 2)) 0 2)))))
167
 
168
 (defgeneric temporal-pattern-key-map (quad)
169
   (:method ((name string))
170
     (aref +temporal-key-maps+ (position name +temporal-database-names+ :test #'string-equal)))
171
   (:method ((tquad t))
172
     (aref +temporal-key-maps+ (temporal-pattern-key-map-index tquad))))
173
 
174
 (flet ((temporal-index-predicate-lambda (name order)
175
          "Storage is always g.s.p.o.t and tests are arranged to sort with different precedence.
176
   The maps place the timestamp in the dominant position and the graph last.
177
   The object follows that, but is not significant as it is redundant for searches."
178
          `(lambda (%lhs %rhs)
179
             (block ,name
180
               (let ((%lhs-tquad (cffi:foreign-slot-value %lhs '(:struct liblmdb:val) 'liblmdb:mv-data))
181
                     (%rhs-tquad (cffi:foreign-slot-value %rhs '(:struct liblmdb:val) 'liblmdb:mv-data)))
182
                 (declare (dynamic-extent %lhs-tquad %rhs-tquad))
183
                 (flet ((cmp (i)
184
                          (let ((lhs_i (cffi:mem-aref %lhs-tquad 'term-id i))
185
                                (rhs_i (cffi:mem-aref %rhs-tquad 'term-id i)))
186
                            (cond ((< lhs_i rhs_i)
187
                                   (return-from ,name -1))
188
                                  ((> lhs_i rhs_i)
189
                                   (return-from ,name 1))))))
190
                   (declare (inline cmp))
191
                   ;; the dominant position is always the temporal term,
192
                   ;; for which for tquads the value is a timestamp
193
                   (let ((lhs_0 (%tquad-time %lhs-tquad))
194
                         (rhs_0 (%tquad-time %rhs-tquad)))
195
                     (cond ((< lhs_0 rhs_0)
196
                            (return-from ,name -1))
197
                           ((> lhs_0 rhs_0)
198
                            (return-from ,name 1))))
199
                   (cmp ,(aref order 1))
200
                   (cmp ,(aref order 2))
201
                   (cmp ,(aref order 3))
202
                   0))))))
203
   (defparameter +temporal-key-predicates+
204
     (apply #'vector (loop for db-name in +temporal-database-names+
205
                       for db-key-order across +temporal-key-maps+
206
                       for predicate-name = (cons-symbol :rlmdb :%compare-tquad- db-name)
207
                       collect (compile predicate-name (temporal-index-predicate-lambda predicate-name db-key-order))))))
208
 
209
 (macrolet ((def-temporal-index-predicates (db-names)
210
              `(progn ,@(loop for db-name in db-names
211
                          for predicate-name = (cons-symbol :rlmdb :%compare-tquad- db-name)
212
                          collect `(cffi:defcallback ,predicate-name :int ((lhs :pointer) (rhs :pointer))
213
                                     (,predicate-name lhs rhs))))))
214
   (def-temporal-index-predicates #.+temporal-database-names+))
215
 
216
 
217
 (defgeneric time-series-pattern-key-map-index (quad &optional temporal-order-p)
218
   (:method ((quad spocq:quad) &optional temporal-order-p)
219
     (aref +time-series-pattern-mask-index+
220
           (+ (case (spocq:quad-graph quad)
221
                ((|urn:dydra|:|named| |urn:dydra|:|all| nil) 0)
222
                (t 8))
223
              (if (spocq:quad-subject quad) 4 0)
224
              (if (spocq:quad-predicate quad) 2 0)
225
              (if temporal-order-p 1 0))))
226
   (:method ((quad vector) &optional temporal-order-p)
227
     (aref +time-series-pattern-mask-index+
228
           (+ (case (aref quad 0) ((0 -2) 0) (t 8))  ;; can be a graph term number list
229
              (if (zerop (aref quad 1)) 0 4)
230
              (if (zerop (aref quad 2)) 0 2)
231
              (if temporal-order-p 1 0)))))
232
 
233
 (defgeneric time-series-pattern-key-map (quad &optional temporal-order-p)
234
   (:method ((name string) &optional temporal-order-p)
235
     (declare (ignore temporal-order-p))
236
     (aref +time-series-key-maps+ (position name +time-series-database-names+ :test #'string-equal)))
237
   (:method ((tsoquad t) &optional temporal-order-p)
238
     (aref +time-series-key-maps+ (time-series-pattern-key-map-index tsoquad temporal-order-p))))
239
 
240
 (flet ((time-series-ordinal-predicate-lambda (name order)
241
          "Storage is always g.s.p.o.t and tests are arranged to sort with different precedence.
242
   The object is not significant as it is redundant for searches.
243
   The revision ordinal is the last term. As an ordinal it comparse the same as term ordinals."
244
          `(lambda (%lhs %rhs)
245
             (block ,name
246
               (let ((%lhs-tsoquad (cffi:foreign-slot-value %lhs '(:struct liblmdb:val) 'liblmdb:mv-data))
247
                     (%rhs-tsoquad (cffi:foreign-slot-value %rhs '(:struct liblmdb:val) 'liblmdb:mv-data)))
248
                 (declare (dynamic-extent %lhs-tsoquad %rhs-tsoquad))
249
                 (flet ((cmp (i)
250
                          (let ((lhs_i (cffi:mem-aref %lhs-tsoquad 'term-id i))
251
                                (rhs_i (cffi:mem-aref %rhs-tsoquad 'term-id i)))
252
                            (cond ((< lhs_i rhs_i)
253
                                   (return-from ,name -1))
254
                                  ((> lhs_i rhs_i)
255
                                   (return-from ,name 1))))))
256
                   (declare (inline cmp))
257
                   ;; the dominant position is always the tso term,
258
                   ;; for which for tsoquads only ordinals are supported
259
                   (cmp ,(aref order 0))
260
                   (cmp ,(aref order 1))
261
                   (cmp ,(aref order 2))
262
                   (cmp ,(aref order 3))
263
                   0))))))
264
   (defparameter +time-series-ordinal-key-predicates+
265
     (apply #'vector (loop for db-name in +time-series-database-names+
266
                       for db-key-order across +time-series-key-maps+
267
                       for predicate-name = (cons-symbol :rlmdb :%compare-tsoquad- db-name)
268
                       collect (compile predicate-name (time-series-ordinal-predicate-lambda predicate-name db-key-order))))))
269
 
270
 ;;; same structure as temporal predicates
271
 (macrolet ((def-event-index-predicates (db-names)
272
              `(progn ,@(loop for db-name in db-names
273
                          for predicate-name = (cons-symbol :rlmdb :%compare-tsoquad- db-name)
274
                          collect `(cffi:defcallback ,predicate-name :int ((lhs :pointer) (rhs :pointer))
275
                                     (,predicate-name lhs rhs))))))
276
   (def-event-index-predicates #.+time-series-database-names+))
277
 
278
 ) ;; eval-when
279
 
280
 
281
 
282
 
283
 
284
 (:documentation
285
  "Specialize index databases by term complement
286
 - quad :
287
   index term permutations to permit all scan sort orders;
288
   null and ordinal records
289
 - temporal :
290
   index term permutation where the temporal object value replaces the
291
   object term identifer and is always present;
292
   null and ordinal records
293
 - time-series :
294
   index term permutation where a revision designator replaces the
295
   object term identifer and is always present;
296
   null records only - until a form where ordinal records do not just duplicate
297
   the revision information
298
 
299
  The index complemte reflect the precedence.
300
  It does not cover all permutations, as a given index is effective whether or
301
  not the last term is wild.")
302
 
303
 
304
 (defclass rlmdb::quad-database (rlmdb::uniform-key-index-database)
305
   ((names :initform +quad-database-names+ :allocation :class)
306
    (index-database-predicates :initform +quad-key-predicates+ :allocation :class))
307
   (:documentation
308
    "Specialize databases for spog* combination indices.
309
    The initial implementation used mapped key quad databases.
310
    The quad-database uses uniform keys.
311
    THis changes the key representation to use a uniform term order for all
312
    sort orders with a distinct comparison predicate for each.
313
    It abstracts two concrete variables
314
    - void-quad-database : stores no content
315
    - ordinal-quad-database : stores an ordinal insert/delete index"))
316
 
317
 (defclass rlmdb::null-quad-database (rlmdb::null-record-database rlmdb::quad-database)
318
   ()
319
   (:documentation
320
    "Store nothing as the index values"))
321
 
322
 (defclass rlmdb::ordinal-quad-database (rlmdb::ordinal-record-database rlmdb::quad-database)
323
   ()
324
   (:documentation
325
    "Store linear transaction indices as the index values"))
326
 
327
 (defclass rlmdb::replicable-quad-database (rlmdb::replication-record-database rlmdb::quad-database)
328
   ()
329
   (:documentation
330
    "Store replication indices as the index values"))
331
 
332
 
333
 
334
 (defclass rlmdb::temporal-database (rlmdb::uniform-key-index-database)
335
   ((names :initform +temporal-database-names+ :allocation :class)
336
    (index-database-predicates :initform +temporal-key-predicates+ :allocation :class))
337
   (:documentation 
338
    "Specialize databases for spogt* combination indices
339
    These augment the quad terms with a fifth term, a 64bit timestamp.
340
    This augments the respective object term indentifier with the respective
341
    UNIX timeline value 'in-line' in cases where the predicate domain is a
342
    temporal value."))
343
 
344
 (defclass rlmdb::null-temporal-database (rlmdb::null-record-database rlmdb::temporal-database)
345
   ()
346
   (:documentation
347
    "Store nothing as the index values"))
348
 
349
 (defclass rlmdb::ordinal-temporal-database (rlmdb::ordinal-record-database rlmdb::temporal-database)
350
   ()
351
   (:documentation
352
    "Store linear transaction indices as the index values"))
353
 
354
 
355
 (defclass rlmdb::time-series-database (rlmdb::uniform-key-index-database)
356
   ((names :initform +time-series-database-names+ :allocation :class)
357
    (index-database-predicates :initform +time-series-ordinal-key-predicates+ :allocation :class
358
                            :documentation "nb. defined for ordinal comparisons only"))
359
   (:documentation
360
    "Specialize databases for spogr* combination indices.
361
    These augment the quad terms with a transction|revision designator."))
362
 
363
 (defclass rlmdb::ordinal-time-series-database (rlmdb::null-record-database rlmdb::time-series-database)
364
   ()
365
   (:documentation
366
    "Implments the time-series variant which uses the revision ordinal."))
367
 
368
 ;;; no predicate yet
369
 (defclass rlmdb::timestamp-time-series-database (rlmdb::null-record-database rlmdb::time-series-database)
370
   ()
371
   (:documentation
372
    "Implments the time-series variant which uses the revision timestamp."))
373
 
374
 ;; no predicates yet
375
 (defclass rlmdb::identifier-time-series-database (rlmdb::null-record-database rlmdb::time-series-database)
376
   ()
377
   (:documentation
378
    "Implments the time-series variant which uses the revision identifier."))
379
 
380
 
381
 ;;; legacy databases
382
 
383
 (defclass rlmdb::rdfcache-quad-database (rlmdb::uniform-predicate-index-database)
384
   ((names :initform +quad-database-names+ :allocation :class)
385
    (key-maps :initform +quad-key-maps+ :allocation :class)))
386
 
387
 (defclass rlmdb::rdfcache-database (rlmdb::null-record-database rlmdb::rdfcache-quad-database)
388
   ())
389
 
390
 (defclass rlmdb::revisioned-rdfcache-database (rlmdb::ordinal-record-database rlmdb::rdfcache-quad-database)
391
   ())
392
 
393
 
394
 (:documentation
395
  "when initializing, the uniform key variants determinethe predicate specific to hteir term sort
396
   order and use it when opening, which the uniform predicate variants use aways the same predicate,
397
   but set the map")
398
 
399
 (defmethod initialize-instance ((instance rlmdb::uniform-key-index-database) &rest args
400
                                 &key (name (error "quad-database: name is required"))
401
                                 (predicate (aref (index-database-predicates instance)
402
                                                  (position name (index-database-names instance) :test #'equalp))))
403
   (declare (dynamic-extent args))
404
   (apply #'call-next-method
405
          instance
406
          :predicate predicate
407
          args))
408
 
409
 (defmethod initialize-instance ((instance rlmdb::uniform-predicate-index-database) &rest args
410
                                 &key (name (error "quad-database: name is required"))
411
                                 (key-map (aref (index-database-key-maps instance)
412
                                                (position name (index-database-names instance) :test #'equalp))))
413
   (declare (dynamic-extent args))
414
   (apply #'call-next-method
415
          instance
416
          :key-map key-map
417
          args))
418
 
419
 (defmethod lmdb:open-database ((database rlmdb::uniform-predicate-index-database)
420
                                &key (transaction lmdb:*transaction*) create if-does-not-exist)
421
   "The base index database class implements 'legacy' indices.
422
   These reorder the keys to reflect term precedence and apply a uniform sort predicate"
423
   (declare (ignore create if-does-not-exist))
424
   (multiple-value-prog1 (call-next-method)
425
     (liblmdb:set-compare (lmdb::handle transaction) (lmdb::handle database)
426
                          (cffi:callback %compare-keys))))
427
 
428
 (defmethod lmdb:open-database ((database rlmdb::uniform-key-index-database)
429
                                &key (transaction lmdb:*transaction*) create if-does-not-exist)
430
   "The mapped index database classes leave the key term order in their respective order (spog, spogt, rspog, ...)
431
   and instead specify a distinct sort predicate for each precedence."
432
   (declare (ignore create if-does-not-exist))
433
   (multiple-value-prog1 (call-next-method)
434
     (let ((compare-callback (index-database-predicate database)))
435
       (liblmdb:set-compare (lmdb::handle transaction) (lmdb::handle database)
436
                            (cffi-sys::%callback compare-callback)))))
437
 
438
 
439
 ;;; repositories
440
 ;;;
441
 ;;; protocol classes :environment, repository
442
 ;;; revision metadata: synchronic v/s diachronic - determine the index record
443
 ;;; alternative indices: quad-index, temporal-index, revision-index
444
 
445
 (defclass rlmdb::environment (lmdb:environment)
446
   ()
447
   (:documentation "An abstract environment class which adds initargs for creation"))
448
 
449
 (defclass rlmdb:repository (rlmdb::environment spocq.i::repository-storage)
450
   ((revisioned
451
     :initform nil :reader is-revisioned :allocation :class
452
     :documentation "indicates whether revision metadata is available
453
      as the log store and index dbs. determined introspectively based
454
      on their presence on open. if so, then an instance of the concrete
455
      rlmdb:multiversion-repository is instantiated")
456
    (meta-database
457
     :type lmdb:database
458
     :accessor repository-meta-database)
459
    (open-arguments
460
     :initform nil :initarg :open-arguments
461
     :reader repository-open-arguments)
462
    (revision-records
463
     :initform nil
464
     :accessor rlmdb::repository-revision-records
465
     :documentation "see rlmdb:revision-records")
466
    (last-transaction-id
467
     :initform nil
468
     :accessor rlmdb::repository-last-transaction-id
469
     :documentation "this binds the lmdb environment transaction id to serve
470
     in tests for changed repository state.
471
     This is not the Dydra revision ordinal, which is tracked in the meta
472
     database and bound to respective transaction instances.")
473
    (transaction-class
474
     ;; not class allocated, but fail attempts to instantiate an abstract class
475
     :initform (error "transaction-class is required")
476
     :reader repository-transaction-class)
477
    (ordinal-size
478
     :initform (load-time-value (cffi:foreign-type-size 'revision-ordinal))
479
     :reader repository-ordinal-size)))
480
 
481
 (defmethod repository-revision-record-database ((repository rlmdb:repository))
482
   nil)
483
 (defmethod repository-revision-ordinal-database ((repository rlmdb:repository))
484
   nil)
485
 
486
 (defclass rlmdb:synchronic-repository (rlmdb:repository)
487
   ()
488
   (:documentation "A protocol class for repositories which retain just one version of the data"))
489
 
490
 (defclass rlmdb:diachronic-repository (rlmdb:repository)
491
   ()
492
   (:documentation "A protocol class for repositories which qualifi quads with revision information"))
493
 
494
 (defclass rlmdb::revision-metadata-repository (rlmdb:repository)
495
   (;; not automatically. cf tso storage (revisioned :initform t :allocation :class)
496
    (revision-record-database
497
     :type lmdb:database
498
     :accessor repository-revision-record-database)
499
    (revision-ordinal-database
500
     :type lmdb:database
501
     :accessor repository-revision-ordinal-database)
502
    (metadata-database-names
503
     :initform '("log/u32:blob" "log/uuid:u32") :allocation :class
504
     :reader repository-metadata-database-names)))
505
 
506
 (defclass rlmdb::replication-metadata-repository (rlmdb:repository)
507
   ((revision-sequence-database
508
     :accessor repository-revision-sequence-database)))
509
 
510
 
511
 (defclass rlmdb::quad-index-repository (rlmdb:repository)
512
   ((quad-database-class
513
     :reader repository-quad-database-class)
514
    (quad-databases
515
     :accessor repository-quad-databases)
516
    (quad-database-names
517
     :initform +quad-database-names+ :allocation :class
518
     :reader repository-quad-database-names))
519
   (:documentation
520
    "Provide storage for spog* indices. These cover quad term id combinations."))
521
 
522
 (defmethod repository-scan-database ((repository rlmdb::quad-index-repository) scan-order)
523
   (let* ((prefix (make-array (length scan-order) :element-type 'character
524
                              :initial-contents (loop for term-position in scan-order
525
                                                  collect (char-downcase (char (symbol-name term-position) 0)))))
526
          (position (loop for name in (repository-quad-database-names repository)
527
                      for position from 0
528
                      when (string-equal name prefix :end1 (length prefix))
529
                      return position)))
530
     (when position 
531
       (aref (repository-quad-databases repository) position))))
532
 
533
 (defmethod repository-quad-pattern-database ((repository rlmdb::quad-index-repository) (quad t) &key scan-order)
534
   (or (and (wild-quad-pattern-p quad) scan-order
535
            (repository-scan-database repository scan-order))
536
       (aref (repository-quad-databases repository)
537
             (quad-pattern-key-map-index quad))))
538
 
539
 (defclass rlmdb::temporal-index-repository (rlmdb:repository)
540
   ((temporal-databases
541
     :type (vector rlmdb::temporal-index-database)
542
     :accessor repository-temporal-databases)
543
    (temporal-database-class
544
     :reader repository-temporal-database-class)
545
    (temporal-database-names
546
     :initform +temporal-database-names+ :allocation :class
547
     :reader repository-temporal-database-names)
548
    (temporal-predicates
549
     :initform nil
550
     :reader repository-temporal-predicates
551
     :writer setf-repository-temporal-predicates
552
     :documentation
553
     "Binds a list of iri instances which indicate which patterns match against
554
      the temporal indices.
555
      The list is stored among metadata, retrieve upon instantiation and pushed to
556
      metadata when modified.")
557
    (temporal-predicate-ids
558
     :initform nil
559
     :reader repository-temporal-predicate-ids
560
     :writer setf-repository-temporal-predicate-ids
561
     :documentation
562
     "The respective list of temporal predicate term ids"))
563
   (:documentation
564
    "provide storage for spogt* indices. These augment quad term ids with a timeline value"))
565
 
566
 (defmethod repository-scan-database ((repository rlmdb::temporal-index-repository) scan-order)
567
   (let* ((prefix (make-array (length scan-order) :element-type 'character
568
                              :initial-contents (loop for term-position in scan-order
569
                                                  collect (char-downcase (char (symbol-name term-position) 0)))))
570
          (position (loop for name in (repository-temporal-database-names repository)
571
                      for position from 0
572
                      when (string-equal name prefix :end1 (length prefix))
573
                      return position)))
574
     (when position 
575
       (aref (repository-temporal-databases repository) position))))
576
 
577
 (defmethod repository-temporal-pattern-database ((repository rlmdb::temporal-index-repository) (quad t) &key scan-order)
578
   (or (and (wild-quad-pattern-p quad) scan-order
579
            (repository-scan-database repository scan-order))
580
       (aref (repository-temporal-databases repository)
581
             (temporal-pattern-key-map-index quad))))
582
 
583
 (defclass rlmdb::time-series-index-repository (rlmdb:repository)
584
   ((time-series-databases
585
     :type (vector rlmdb::time-series-database)
586
     :accessor repository-time-series-databases)
587
    (time-series-database-class
588
     :allocation :class
589
     :reader repository-time-series-database-class)
590
    (time-series-database-names
591
     :initform +time-series-database-names+ :allocation :class
592
     :reader repository-time-series-database-names)
593
    (time-series-predicates
594
     :initform nil
595
     :reader repository-time-series-predicates
596
     :writer setf-repository-time-series-predicates
597
     :documentation
598
     "Binds a list of iri instances which indicate which patterns match against
599
      the time-series indices.
600
      The list is stored among metadata, retrieve upon instantiation and pushed to
601
      metadata when modified.")
602
    (time-series-predicate-ids
603
     :initform nil
604
     :reader repository-time-series-predicate-ids
605
     :writer setf-repository-time-series-predicate-ids
606
     :documentation
607
     "The respective list of time-series predicate term ids")))
608
 
609
 (defmethod repository-scan-database ((repository rlmdb::time-series-index-repository) scan-order)
610
   (let* ((prefix (make-array (length scan-order) :element-type 'character
611
                              :initial-contents (loop for term-position in scan-order
612
                                                  collect (char-downcase (char (symbol-name term-position) 0)))))
613
          (position (loop for name in (repository-time-series-database-names repository)
614
                      for position from 0
615
                      when (string-equal name prefix :end1 (length prefix))
616
                      return position)))
617
     (when position
618
       (aref (repository-time-series-databases repository) position))))
619
 
620
 (defmethod repository-time-series-pattern-database ((repository rlmdb::time-series-index-repository) (quad t) &key scan-order)
621
   (or (and (wild-quad-pattern-p quad) scan-order
622
            (repository-scan-database repository scan-order))
623
       (aref (repository-time-series-databases repository)
624
             (time-series-pattern-key-map-index quad))))
625
 
626
 (defclass rlmdb::null-quad-index-repository (rlmdb::quad-index-repository)
627
   ((quad-database-class
628
     :initform 'rlmdb::null-quad-database :allocation :class)
629
    (quad-databases
630
     :type (vector rlmdb::null-quad-database))))
631
 
632
 (defclass rlmdb::ordinal-quad-index-repository (rlmdb::quad-index-repository)
633
   ((quad-database-class
634
     :initform 'rlmdb::ordinal-quad-database :allocation :class)
635
    (quad-databases
636
     :type (vector rlmdb::ordinal-quad-database))))
637
 
638
 (defclass rlmdb::replicable-quad-index-repository (rlmdb::quad-index-repository)
639
   ((quad-database-class
640
     :initform 'rlmdb::replicable-quad-database :allocation :class)
641
    (quad-databases
642
     :type (vector rlmdb::replicable-quad-database))))
643
 
644
 (defclass rlmdb::null-temporal-index-repository (rlmdb::temporal-index-repository)
645
   ((temporal-database-class
646
     :initform 'rlmdb::null-temporal-database :allocation :class)
647
    (temporal-databases
648
     :type (vector rlmdb::null-temporal-database))))
649
 
650
 (defclass rlmdb::ordinal-temporal-index-repository (rlmdb::temporal-index-repository)
651
   ((temporal-database-class
652
     :initform 'rlmdb::ordinal-temporal-database :allocation :class)
653
    (temporal-databases
654
     :type (vector rlmdb::ordinal-temporal-database))))
655
 
656
 (defclass rlmdb::ordinal-time-series-index-repository (rlmdb::time-series-index-repository)
657
   ((time-series-database-class
658
     :initform 'rlmdb::ordinal-time-series-database :allocation :class)
659
    (time-series-databases
660
     :type (vector rlmdb::ordinal-time-series-database))))
661
 
662
 (defclass rlmdb::timestamp-time-series-index-repository (rlmdb::time-series-index-repository)
663
   ((time-series-database-class
664
     :initform 'rlmdb::timestamp-time-series-database :allocation :class)
665
    (time-series-databases
666
     :type (vector rlmdb::timestamp-time-series-database))))
667
 
668
 (defclass rlmdb::identifier-time-series-index-repository (rlmdb::time-series-index-repository)
669
   ((time-series-database-class
670
     :initform 'rlmdb::identifier-time-series-database :allocation :class)
671
    (time-series-databases
672
     :type (vector rlmdb::identifier-time-series-database))))
673
 
674
 
675
 (defgeneric rlmdb:repository-database-names (repository)
676
   (:documentation
677
    "return the aggregate list of the names of the databases comprised by the repository.")
678
   (:method-combination append)
679
   (:method append ((repository t))
680
     ())
681
   (:method append ((repository spocq.i:repository))
682
     (rlmdb:repository-database-names (spocq.i:repository-lmdb-repository repository)))
683
   (:method append ((repository rlmdb:repository))
684
     (list "meta"))
685
   (:method append ((repository rlmdb::revision-metadata-repository))
686
     (repository-metadata-database-names repository))
687
   (:method append ((repository rlmdb::quad-index-repository))
688
     (repository-quad-database-names repository))
689
   (:method append ((repository rlmdb::temporal-index-repository))
690
     (repository-temporal-database-names repository))
691
   (:method append ((repository rlmdb::time-series-index-repository))
692
     (repository-time-series-database-names repository))
693
   (:method append ((repository rlmdb::replicable-quad-index-repository))
694
     (list *revision-sequence-database-name*)))
695
 
696
 (defgeneric rlmdb:repository-databases (repository)
697
   (:documentation
698
    "return the aggregate list of the names of the databases comprised by the repository.")
699
   (:method-combination append :most-specific-last)
700
   (:method append ((repository t))
701
     ())
702
   (:method append ((repository spocq.i:repository))
703
     (rlmdb:repository-databases (spocq.i:repository-lmdb-repository repository)))
704
   (:method append ((repository rlmdb:repository))
705
     (list (repository-meta-database repository)))
706
   (:method append ((repository rlmdb::revision-metadata-repository))
707
     (list (repository-revision-record-database repository)  (repository-revision-ordinal-database repository)))
708
   (:method append ((repository rlmdb::quad-index-repository))
709
     (repository-quad-databases repository))
710
   (:method append ((repository rlmdb::temporal-index-repository))
711
     (repository-temporal-databases repository))
712
   (:method append ((repository rlmdb::time-series-index-repository))
713
     (repository-time-series-databases repository))
714
   (:method append ((repository rlmdb::replicable-quad-index-repository))
715
     (list (repository-revision-sequence-database repository))))
716
 
717
 (defclass rlmdb:transaction (lmdb:transaction)
718
   ((lock
719
     :initform (bt:make-lock "rlmdb:transaction lock") :initarg :lock
720
     :reader transaction-lock)
721
    (inserted-count
722
     :initform 0
723
     :accessor transaction-inserted-count)
724
    (deleted-count
725
     :initform 0
726
     :accessor transaction-deleted-count)
727
    (timeout
728
     :initform 30
729
     :accessor rlmdb:transaction-timeout)
730
    (default-graph-term-id
731
        :initform #xffffffff :allocation :class
732
      :reader rlmdb:transaction-default-context-term-id))
733
   (:documentation "Introduce locking and counts for write transactions"))
734
 
735
 (defclass rlmdb:lmdb-transaction (rlmdb:transaction)
736
   ((uuid :initform (string-downcase (make-v1-uuid-string))
737
          :reader rlmdb:transaction-uuid)
738
    (start :initform (get-timeline-location)
739
           :reader rlmdb:transaction-start)
740
    (end :initform nil
741
         :accessor rlmdb:transaction-end)))
742
 (defclass rlmdb:rdfcache-transaction (rlmdb:transaction) ())
743
 
744
 (defclass rlmdb:quad-transaction (rlmdb:lmdb-transaction) ())
745
 (defclass rlmdb:revisioned-transaction (rlmdb:lmdb-transaction) ())
746
 (defclass rlmdb:temporal-transaction (rlmdb:lmdb-transaction) ())
747
 (defclass rlmdb:bitemporal-transaction (rlmdb:lmdb-transaction) ())
748
 (defclass rlmdb:time-series-transaction (rlmdb:lmdb-transaction) ())
749
 (defclass rlmdb:bitemporal-time-series-transaction (rlmdb:lmdb-transaction) ())
750
 (defclass rlmdb:replicable-transaction (rlmdb:lmdb-transaction) ())
751
 
752
 (defclass rlmdb:rdfcache-quad-transaction (rlmdb:rdfcache-transaction) ())
753
 (defclass rlmdb:rdfcache-revisioned-transaction (rlmdb:rdfcache-transaction) ())
754
 
755
 
756
 ;;; rdfcache-based
757
 
758
 (defclass rlmdb::rdfcache-repository ()
759
   ()
760
   (:documentation
761
    "An rlmdb::rdfcache-repository is a protocol class to distinguish repositories
762
   with non-uniform quad indices."))
763
 
764
 (defclass rlmdb:rdfcache-quad-repository (rlmdb::rdfcache-repository rlmdb::quad-index-repository rlmdb:synchronic-repository)
765
   ((quad-database-class
766
     :initform 'rlmdb::rdfcache-database :allocation :class)
767
    (transaction-class
768
     :initform 'rlmdb:rdfcache-quad-transaction :allocation :class)))
769
 
770
 (defclass rlmdb:revisioned-rdfcache-quad-repository (rlmdb::rdfcache-repository rlmdb::quad-index-repository rlmdb::revision-metadata-repository rlmdb:diachronic-repository)
771
   ((quad-database-class
772
     :initform 'rlmdb::revisioned-rdfcache-database :allocation :class)
773
    (transaction-class
774
     :initform 'rlmdb:rdfcache-revisioned-transaction :allocation :class)))
775
 
776
 (defmethod validate-storage-class ((repository lmdb-repository) (storage rlmdb:repository))
777
   "The minimal repository must include the meta database"
778
   t)
779
 
780
 
781
 ;;; lmdb-direct
782
 ;;; the class precedence is ordered to permit selective mapping (see rlmdb:map-repository-statements)
783
 
784
 (defclass rlmdb:quad-repository (rlmdb::null-quad-index-repository rlmdb::synchronic-repository)
785
   ((transaction-class
786
     :initform 'rlmdb:quad-transaction :allocation :class)))
787
 
788
 (defclass rlmdb:revisioned-repository (rlmdb::ordinal-quad-index-repository rlmdb::revision-metadata-repository rlmdb:diachronic-repository)
789
   ((transaction-class
790
     :initform 'rlmdb:revisioned-transaction :allocation :class)))
791
 
792
 
793
 (defclass rlmdb:temporal-repository (rlmdb::null-temporal-index-repository rlmdb::null-quad-index-repository rlmdb::synchronic-repository)
794
   ((transaction-class
795
     :initform 'rlmdb:temporal-transaction :allocation :class)))
796
 
797
 (defclass rlmdb:bitemporal-repository (rlmdb::ordinal-temporal-index-repository rlmdb::ordinal-quad-index-repository rlmdb::revision-metadata-repository rlmdb:diachronic-repository)
798
   ((transaction-class
799
     :initform 'rlmdb:bitemporal-transaction :allocation :class)))
800
 
801
 
802
 ;;; define time series repositories for the ordinal variant
803
 
804
 #+(or) ;; 20200924: not used
805
 (defclass rlmdb:time-series-repository (rlmdb::ordinal-time-series-index-repository rlmdb::revision-metadata-repository)
806
   ((transaction-class
807
     :initform 'rlmdb:time-series-transaction))
808
   (:documentation "Combine the revision uuid/ordinal/timestamp metadata with the ordinal index"))
809
 
810
 (defclass rlmdb:time-series-quad-repository (rlmdb::ordinal-time-series-index-repository rlmdb::null-quad-index-repository rlmdb::revision-metadata-repository rlmdb::synchronic-repository)
811
   ((transaction-class
812
     :initform 'rlmdb:time-series-transaction))
813
   (:documentation "Combine the revision uuid/ordinal/timestamp metadata with the ordinal index"))
814
 
815
 (defclass rlmdb:time-series-temporal-repository (rlmdb::ordinal-time-series-index-repository rlmdb::null-temporal-repository rlmdb::revision-metadata-repository rlmdb::synchronic-repository)
816
   ((transaction-class
817
     :initform 'rlmdb:time-series-transaction))
818
   (:documentation "Combine the revision uuid/ordinal/timestamp metadata with the ordinal index"))
819
 
820
 (defclass rlmdb:time-series-bitemporal-repository (rlmdb::ordinal-time-series-index-repository rlmdb:bitemporal-repository rlmdb::diachronic-repository)
821
   ((transaction-class
822
     :initform 'rlmdb:bitemporal-time-series-transaction :allocation :class)))
823
 
824
 
825
 (defclass rlmdb:replicable-repository (rlmdb::replicable-quad-index-repository rlmdb::revision-metadata-repository rlmdb::replication-metadata-repository rlmdb::diachronic-repository)
826
   ((transaction-class
827
     :initform 'rlmdb:replicable-transaction :allocation :class)))
828
 
829
 
830
 (defmethod validate-storage-class ((repository rdfcache-lmdb-repository) (storage rlmdb::rdfcache-repository))
831
   t)
832
 (defmethod validate-storage-class ((repository lmdb-quad-repository) (storage rlmdb:quad-repository))
833
   t)
834
 (defmethod validate-storage-class ((repository lmdb-revisioned-repository) (storage rlmdb:revisioned-repository))
835
   t)
836
 (defmethod validate-storage-class ((repository lmdb-temporal-repository) (storage rlmdb:temporal-repository))
837
   t)
838
 (defmethod validate-storage-class ((repository lmdb-bitemporal-repository) (storage rlmdb:bitemporal-repository))
839
   t)
840
 #+(or)
841
 (defmethod validate-storage-class ((repository lmdb-time-series-repository) (storage rlmdb:time-series-repository))
842
   t)
843
 (defmethod validate-storage-class ((repository lmdb-time-series-quad-repository) (storage rlmdb:time-series-quad-repository))
844
   t)
845
 (defmethod validate-storage-class ((repository lmdb-time-series-temporal-repository) (storage rlmdb:time-series-temporal-repository))
846
   t)
847
 (defmethod validate-storage-class ((repository lmdb-time-series-bitemporal-repository) (storage rlmdb:time-series-bitemporal-repository))
848
   t)
849
 (defmethod validate-storage-class ((repository lmdb-replicable-repository) (storage rlmdb:replicable-repository))
850
   t)
851
           
852
 
853
 (defmethod initialize-instance ((instance rlmdb::environment) &key
854
                                 (directory (error "directory is required"))
855
                                 (if-exists :append)
856
                                 (if-does-not-exist :create))
857
   (if (probe-file directory)
858
       (ecase if-exists
859
         (nil nil)
860
         (:append (call-next-method))
861
         (:overwrite (call-next-method))
862
         (:supersede (call-next-method))
863
         (:error (spocq.e:resource-found-error :resource directory)))
864
       (ecase if-does-not-exist
865
         ((nil) nil)
866
         (:create (ensure-directories-exist directory)
867
                  (call-next-method))
868
         (:error  (spocq.e:resource-not-found-error :resource directory)))))
869
 
870
 
871
 
872
 (defmethod initialize-instance ((instance rlmdb:repository) &rest initargs
873
                                 &key name account
874
                                 repository
875
                                 id
876
                                 (repository-id (cond (id)
877
                                                      ((and name account)
878
                                                       (spocq.i:compute-repository-id account name))
879
                                                      (repository
880
                                                       (spocq.i::repository-id repository))
881
                                                      (t
882
                                                       (error "repository-id is required"))))
883
                                 (directory (or (spocq.i:repository-pathname repository-id)
884
                                                (spocq.e:repository-not-found-error
885
                                                 :identifier repository-id)))
886
                                 (mapsize rlmdb:*mapsize*)
887
                                 (maxdbs (length (rlmdb:repository-database-names instance)))
888
                                 (max-readers rlmdb:*max-readers*)
889
                                 (if-does-not-exist :create)
890
                                 external-name)
891
   (declare (dynamic-extent initargs)
892
            (ignore external-name))
893
   (apply #'call-next-method instance
894
          :directory directory
895
          :repository-id repository-id
896
          :max-databases maxdbs
897
          :mapsize mapsize
898
          :max-readers max-readers
899
          :if-does-not-exist if-does-not-exist
900
          initargs)
901
   (assert (or (probe-file directory) (eq if-does-not-exist nil)) ()
902
           "rlmdb:repository: path does not exist")
903
   ;; do not open it, in order to permit the rare case of activation with dynamic extent
904
   )
905
 
906
 (defmethod initialize-instance :after ((instance rlmdb::repository) &key
907
                                        (if-exists :append))
908
   "Iff overwrite or supsersede is specified delete the index database contents.
909
    For :supersede delete also and revision history"
910
  (if (probe-file (lmdb:environment-directory instance))
911
      (case if-exists
912
        (:overwrite
913
         ;; retain all metadata - esp the properties which controll access
914
         (rlmdb:clear-repository instance :type '(not metadata-database)))
915
        (:supersede
916
         ;; delete everything
917
         (rlmdb:clear-repository instance :type t)))))
918
 
919
 
920
 (defgeneric rlmdb:open-repository (repository)
921
   (:method ((repository rlmdb:repository))
922
     (apply #'lmdb:open-environment repository (repository-open-arguments repository))))
923
 
924
 (defmethod lmdb:open-environment ((repository rlmdb:repository) &rest args
925
                                   &key if-does-not-exist class)
926
   (declare (ignore if-does-not-exist class))
927
   (call-next-method)
928
   (apply #'rlmdb:open-environment-databases repository args))
929
 
930
 (defun ensure-environment-database (repository name &key (if-does-not-exist :error) (class (error "class is required.")))
931
   (let ((db (lmdb:make-database name
932
                                 :class class
933
                                 :repository repository)))
934
     (lmdb:open-database db :if-does-not-exist if-does-not-exist)))
935
 
936
 (defmethod lmdb:make-transaction ((repository rlmdb:repository) &rest args
937
                                   &key (class (repository-transaction-class repository)))
938
   (apply #'call-next-method repository
939
          :class class
940
          args))
941
 
942
 (defmethod lmdb:leave-transaction ((transaction rlmdb:lmdb-transaction) (disposition (eql :commit)))
943
   "If the transaction is a write transaction, update the metadata to reflect it.
944
    (presume write for a commit disposition)"
945
   (unless (logtest (lmdb:transaction-flags transaction) liblmdb:+rdonly+)
946
     (rlmdb:put-repository-metadata (lmdb:transaction-environment transaction)
947
                                    :uuid (rlmdb::transaction-uuid transaction)
948
                                    :ordinal (lmdb:transaction-id transaction)
949
                                    :end (setf (rlmdb::transaction-end transaction) (get-timeline-location))
950
                                    :start (rlmdb::transaction-start transaction)))
951
   (call-next-method))
952
 
953
 (defmethod rlmdb:decode-metadata ((name (eql :|temporal-properties|)) (data vector))
954
   (decode-metadata-string data))
955
 
956
 (defmethod rlmdb:decode-metadata ((name (eql :|time-series-properties|)) (data vector))
957
   (decode-metadata-string data))
958
 
959
 (defgeneric rlmdb:open-environment-databases (repository &rest args)
960
   (:documentation
961
    "open the environment databases, leaving them open for subsequent use.
962
     if this is this initial transaction, pass :create to create them.")
963
 
964
   ;; order to ensure that the repository method is first in order to have the
965
   ;; meta database available for storage specializations.
966
   (:method-combination progn :most-specific-last)
967
 
968
   (:method :around ((environment lmdb:environment) &key (if-does-not-exist :error) (class nil))
969
     ;; nb. this commits also read-only transactions in order to make the databases available,
970
     ;; but it should not update the metadata
971
     (let ((transaction (lmdb:make-transaction environment
972
                                               :flags (case if-does-not-exist
973
                                                        (:create 0)
974
                                                        (t liblmdb:+rdonly+)))))
975
       (lmdb:with-transaction (transaction :initial-disposition :begin :normal-disposition :commit)
976
         (call-next-method environment :if-does-not-exist if-does-not-exist)
977
         (when (and class (eq if-does-not-exist :create))
978
           (rlmdb:put-metadata-class environment class)
979
           (let ((timestamp (get-timeline-location))
980
                 (uuid (string-downcase (spocq.i::make-v1-uuid-string)))
981
                 (id (lmdb:transaction-id transaction)))
982
             (rlmdb:put-repository-metadata environment 
983
                                            :uuid uuid
984
                                            :ordinal id
985
                                            :end timestamp
986
                                            :start timestamp))))))
987
 
988
   (:method progn ((repository rlmdb:repository) &key if-does-not-exist)
989
     "establish the generic metadata database."
990
     (setf (repository-meta-database repository)
991
           (ensure-environment-database repository *meta-database-name*
992
                                        :if-does-not-exist if-does-not-exist
993
                                        :class 'rlmdb:meta-database)))
994
 
995
    (:method progn ((repository rlmdb::revision-metadata-repository) &key if-does-not-exist)
996
      (setf (repository-revision-ordinal-database repository)
997
            (ensure-environment-database repository *revision-ordinal-database-name*
998
                                         :if-does-not-exist if-does-not-exist
999
                                         :class 'rlmdb:revision-ordinal-database))
1000
      (setf (repository-revision-record-database repository)
1001
            (ensure-environment-database repository *revision-record-database-name*
1002
                                         :if-does-not-exist if-does-not-exist
1003
                                         :class 'rlmdb:revision-record-database))
1004
      repository)
1005
 
1006
   (:method progn ((repository rlmdb::quad-index-repository) &key if-does-not-exist)
1007
     (setf (repository-quad-databases repository)
1008
           (apply #'vector (loop with class = (repository-quad-database-class repository)
1009
                             for name in (repository-quad-database-names repository)
1010
                             collect (ensure-environment-database repository name
1011
                                                                  :if-does-not-exist if-does-not-exist
1012
                                                                  :class class))))
1013
     repository)
1014
 
1015
   (:method progn ((repository rlmdb::temporal-index-repository) &key if-does-not-exist)
1016
     (setf (repository-temporal-databases repository)
1017
           (apply #'vector (loop with class = (repository-temporal-database-class repository)
1018
                             for name in (repository-temporal-database-names repository)
1019
                             collect (ensure-environment-database repository name
1020
                                                                  :if-does-not-exist if-does-not-exist
1021
                                                                  :class class))))
1022
     (setf-repository-temporal-predicates
1023
      (let ((property (get-metadata-property (repository-meta-database repository) "temporal-properties")))
1024
        (when property
1025
          (loop for iri-namestring in (split-string property " ")
1026
            collect (intern-iri iri-namestring))))
1027
      repository)
1028
     (setf-repository-temporal-predicate-ids
1029
      (with-open-repository ("system/null" :agent (system-agent))
1030
        (map 'vector #'(lambda (predicate)
1031
                         (spocq.i::rdfcache-object-term-number spocq.i:*transaction* predicate))
1032
             (repository-temporal-predicates repository)))
1033
      repository)
1034
     repository)
1035
 
1036
   (:method progn ((repository rlmdb::time-series-index-repository) &key if-does-not-exist)
1037
     (setf (repository-time-series-databases repository)
1038
           (apply #'vector (loop with class = (repository-time-series-database-class repository)
1039
                             for name in (repository-time-series-database-names repository)
1040
                             collect (ensure-environment-database repository name
1041
                                                                  :if-does-not-exist if-does-not-exist
1042
                                                                  :class class))))
1043
     (setf-repository-time-series-predicates
1044
      (let ((property (get-metadata-property (repository-meta-database repository) "time-series-properties")))
1045
        (when property
1046
          (loop for iri-namestring in (split-string property " ")
1047
            collect (intern-iri iri-namestring))))
1048
      repository)
1049
     (setf-repository-time-series-predicate-ids
1050
      (with-open-repository ("system/null" :agent (system-agent))
1051
        (map 'vector #'(lambda (predicate) (spocq.i::rdfcache-object-term-number spocq.i:*transaction* predicate))
1052
             (repository-time-series-predicates repository)))
1053
      repository)
1054
     repository)
1055
 
1056
   (:method progn ((repository rlmdb:replicable-repository) &key if-does-not-exist)
1057
     "open the repository environment as normal and then follow with the sha1:revision-sequence
1058
     database"
1059
     (setf (repository-revision-sequence-database repository)
1060
           (ensure-environment-database repository *revision-sequence-database-name*
1061
                                        :if-does-not-exist if-does-not-exist
1062
                                        :class 'rlmdb:revision-sequence-database))
1063
     repository)
1064
   )
1065
 
1066
 
1067
 
1068
 (defmethod rlmdb:repository-temporal-predicate-p ((repository rlmdb::temporal-index-repository) (predicate-id integer))
1069
   (position predicate-id (repository-temporal-predicate-ids repository)))
1070
 (defmethod rlmdb:repository-temporal-predicate-p ((repository rlmdb::temporal-index-repository) (predicate-term t))
1071
   (position predicate-term (repository-temporal-predicates repository) :test #'iri-equal))
1072
 
1073
 (defmethod rlmdb:repository-time-series-predicate-p ((repository rlmdb::time-series-index-repository) (predicate-id integer))
1074
   (position predicate-id (repository-time-series-predicate-ids repository)))
1075
 (defmethod rlmdb:repository-time-series-predicate-p ((repository rlmdb::time-series-index-repository) (predicate-term t))
1076
   (position predicate-term (repository-time-series-predicates repository) :test #'iri-equal))
1077
 
1078
 (defgeneric database-quad-event-key (database %record)
1079
   (:method ((database rlmdb::ordinal-time-series-database) %tsoquad)
1080
     (%tsoquad-ordinal %tsoquad))
1081
   (:method ((database rlmdb::ordinal-time-series-database) %tstquad)
1082
     (%tstquad-time %tstquad))
1083
   (:method ((database rlmdb::ordinal-time-series-database) %tsiquad)
1084
     (rlmdb:decode-metadata :|revision-uuid| (%tsiquad-uuid %tsiquad))))
1085
 
1086
 #+(or) ;; unused, uuid string suffices
1087
 (defgeneric database-quad-event-object (database %record)
1088
   (:method ((database rlmdb::ordinal-time-series-database) %tsoquad)
1089
     (%tsoquad-ordinal %tsoquad))
1090
   (:method ((database rlmdb::ordinal-time-series-database) %tstquad)
1091
     (%tstquad-time %tstquad))
1092
   (:method ((database rlmdb::ordinal-time-series-database) %tsiquad)
1093
     (intern-uuid (rlmdb:decode-metadata :|revision-uuid| (%tsiquad-uuid %tsiquad)))))
1094
 
1095
 
1096
 (defun rlmdb:repository (&rest args)
1097
   (declare (dynamic-extent args))
1098
   (apply #'make-instance *class.rlmdb-repository* args))
1099
 
1100
 (defgeneric rlmdb:close-repository (repository)
1101
   (:method ((repository rlmdb:repository))
1102
     (when (lmdb:open-p repository)
1103
       ;; actively close any open databases
1104
       (lmdb:close-environment repository))))
1105
 
1106
 (defmethod lmdb:open-p ((repository rlmdb:repository))
1107
   (call-next-method))
1108
 
1109
 (defmethod spocq.i::repository-wildcard-term ((repository rlmdb:repository))
1110
   0)
1111
 
1112
 (defmethod repository-revision-record-database ((database rlmdb::database))
1113
   (repository-revision-record-database (database-repository database)))
1114
 
1115
 (defmethod repository-revision-ordinal-database ((database rlmdb::database))
1116
   (repository-revision-ordinal-database (database-repository database)))
1117
 
1118
 (defmethod repository-meta-database ((database rlmdb::database))
1119
   (repository-meta-database (database-repository database)))
1120
 
1121
 (defmethod rlmdb::repository-gspo-database ((repository rlmdb::quad-index-repository))
1122
   (aref (repository-quad-databases repository)
1123
         (load-time-value (position "gspo" +quad-database-names+ :test #'string-equal))))
1124
 (defmethod rlmdb::repository-spog-database ((repository rlmdb::quad-index-repository))
1125
   (aref (repository-quad-databases repository)
1126
         (load-time-value (position "spog" +quad-database-names+ :test #'string-equal))))
1127
 (defmethod rlmdb::repository-posg-database ((repository rlmdb::quad-index-repository))
1128
   (aref (repository-quad-databases repository)
1129
         (load-time-value (position "posg" +quad-database-names+ :test #'string-equal))))
1130
 (defmethod rlmdb::repository-ospg-database ((repository rlmdb::quad-index-repository))
1131
   (aref (repository-quad-databases repository)
1132
         (load-time-value (position "ospg" +quad-database-names+ :test #'string-equal))))
1133
 
1134
 (define-condition revision-designator-error (simple-error)
1135
   ((designator
1136
     :initarg :designator :initform nil
1137
     :reader condition-designator)
1138
    (qualifiers
1139
     :initarg :qualifiers :initform nil
1140
     :reader condition-qualifiers))
1141
   (:report (lambda (condition stream)
1142
              (format stream "~(~a~): ~s~@[ . ~s~]"
1143
                      (type-of condition)
1144
                      (condition-designator condition)
1145
                      (condition-qualifiers condition)))))
1146
 
1147
 (define-condition invalid-revision-designator (revision-designator-error)
1148
   ())
1149
 
1150
 (define-condition revision-not-found (revision-designator-error spocq.e:revision-not-found-error)
1151
   ())
1152
 
1153
                   
1154
 (defun signal-invalid-revision-designator (revision-designator &key
1155
                                                                (if-does-not-exist :error)
1156
                                                                (class 'invalid-revision-designator)
1157
                                                                offset first last
1158
                                                                (qualifiers `(,@(when offset `(:offset ,offset))
1159
                                                                                ,@(when first `(:first ,first))
1160
                                                                                ,@(when last `(:last ,last)))))
1161
   (ecase if-does-not-exist
1162
     (:error (error class :designator revision-designator
1163
                    :qualifiers qualifiers))
1164
     ((nil) nil)))
1165
 
1166
 (defun signal-revision-not-found (revision-designator &key
1167
                                                       (if-does-not-exist :error)
1168
                                                       (class 'revision-not-found)
1169
                                                       offset first last
1170
                                                       (qualifiers `(,@(when offset `(:offset ,offset))
1171
                                                                                ,@(when first `(:first ,first))
1172
                                                                                ,@(when last `(:last ,last)))))
1173
   (ecase if-does-not-exist
1174
     (:error (error class :designator revision-designator
1175
                    :qualifiers qualifiers))
1176
     ((nil) nil)))
1177
 
1178
 
1179
 (defmethod lmdb:print-object-slots ((object rlmdb:repository) stream)
1180
   (format stream "~a " (bound-slot-value object 'repository-id))
1181
   (call-next-method))
1182
     
1183
 (defmethod print-object ((object rlmdb:repository) stream)
1184
   (call-next-method))
1185
 
1186
 (defmethod lmdb:abort-transaction ((transaction rlmdb:transaction))
1187
   (bt:with-lock-held ((transaction-lock transaction))
1188
     (call-next-method)))
1189
 
1190
 (defmethod lmdb:begin-transaction ((transaction rlmdb:transaction) &rest args)
1191
   (declare (ignore args))
1192
   (bt:with-lock-held ((transaction-lock transaction))
1193
     (call-next-method)))
1194
 
1195
 (defmethod lmdb:commit-transaction ((transaction rlmdb:transaction))
1196
   (bt:with-lock-held ((transaction-lock transaction))
1197
     (call-next-method)))
1198
 
1199
 (defmethod spocq.i::read-repository-statement-count ((repository rlmdb:repository))
1200
   (rlmdb::entry-count repository))
1201
 
1202
 ;;;
1203
 ;;; path term resolution
1204
 
1205
 ;;; provide a generic interface operator to allos later transaction-relative specialization
1206
 (defgeneric rlmdb:intern-property-path (property-path)
1207
   (:documentation "Intern a property path in a given transaction context. Descend to each verb in the path,
1208
     intern its term and cache the respective term number.")
1209
 
1210
   (:method ((path spocq.i::unary-property-path))
1211
     (rlmdb:intern-property-path (spocq.i::unary-property-path-element path))
1212
     path)
1213
 
1214
   (:method ((path spocq.i::nary-property-path))
1215
     (dolist (element (spocq.i::nary-property-path-elements path))
1216
       (rlmdb:intern-property-path element))
1217
     path)
1218
 
1219
   (:method ((path spocq.i::property-path-verb))
1220
     (or (spocq.i::property-path-verb-value path)
1221
         (setf (spocq.i::property-path-verb-value path)
1222
               (rlmdb:value-term-number (spocq.i::property-path-verb-iri path))))))
1223
 
1224
 ;;; hash chain computations
1225
 
1226
 (defmethod compute-rlmdb-revision-signature ((repository-id string) &rest args)
1227
   (declare (dynamic-extent args))
1228
   (apply #'compute-rlmdb-revision-signature (spocq.i::repository-lmdb-repository (spocq.i:repository repository-id))
1229
          args))
1230
 
1231
 (defmethod compute-rlmdb-revision-signature ((transaction rlmdb:transaction) &rest args)
1232
   (declare (dynamic-extent args))
1233
   (apply #'compute-rlmdb-revision-signature (lmdb:transaction-environment transaction) args))
1234
 
1235
 (defmethod compute-rlmdb-revision-signature ((repository rlmdb:repository) &key
1236
                                              (digest-type spocq.i::*revision-signature-type*)
1237
                                              (first (rlmdb:find-last-ordinal repository))
1238
                                              last)
1239
   (let ((quad-byte-vector (make-array 32 :element-type '(unsigned-byte 8)))
1240
         (digest (ironclad:make-digest digest-type))
1241
         (count 0)
1242
         (predicate (when (or first last) (spocq.i::compute-revision-predicate (list :first first :last last)))))
1243
       (flet ((update-digest (%quad)
1244
                (dotimes (i 32) (setf (aref quad-byte-vector i) (cffi:mem-aref %quad :uint8 i)))
1245
                (ironclad:update-digest digest quad-byte-vector)
1246
                (incf count)))
1247
         (declare (dynamic-extent #'update-digest))
1248
         (rlmdb:map-repository-statements #'update-digest repository #(0 0 0 0)
1249
                                          :revision-predicate predicate))
1250
     (values (ironclad:byte-array-to-hex-string (ironclad:produce-digest digest))
1251
             count)))
1252
 
1253
 ;;; (compute-rlmdb-revision-signature "james/test" :digest-type :sha256)
1254
 ;;; (time (compute-repository-digest "nxp/plm" :sha256))
1255
 ;;; (/ 17672849 13.812) = 1279528.5/sec this is about 1% of the straight byte rate
1256
   
1257