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

KindCoveredAll%
expression3451665 20.7
branch974 12.2
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.spocq.implementation; -*-
2
 
3
 (in-package :org.datagraph.rdf.lmdb.implementation)
4
 
5
 (:documentation "LMDB repository binding
6
  Serves as delegate for Dydra repositories, which are stored as a complement of
7
  databases in an LMDB environment.
8
  ")
9
 
10
 #|
11
 a streaming repository permits temporal ranges.
12
 the schematic storage for a repository is as an lmdb environment, as a directory
13
 in /srv/dydra/catalog/repositories/
14
  data.mdb
15
  lock.mdb
16
 
17
 the data file comprises the lmdb databases:
18
  'log/u32:blob' : ordinal->revision-record
19
   some ordinals either do not have a log db entry or the record is not valid
20
   in that it has no timestamp (as it was created, but never commited ?)
21
  'log/uuid:u32' : uuid->ordinal
22
  'meta' : the properties of the latest (or only) revision
23
  'spog'* : the quad->visibility indices
24
  'log/u32:graph' : the direct revision->graph index (not present in dydra-cgi code)
25
  'sha1:revision-sequence' : store revision sequences keyed by their sha1
26
 
27
 repository lifecycle : 
28
 - make-instance always creates and opens rlmdb:repository
29
 - open
30
  retrieve the repository environment;
31
  retain the environment until the repository is unreachable, then close it
32
  create and commit a dynamic transaction in that env to open the databases
33
  leave the databases themselves open
34
 - finalize
35
  close the rlmdb:repository, which closes the lmdb:environment
36
 
37
 transaction lifecycle :
38
 - transaction-open(lmdb-transaction) ensures an lmdb:transaction
39
 - transaction-commit,abort(lmdb-transaction) leaves it intact
40
 - destr
41
 - currently opened and aborted
42
 
43
 database lifecycle :
44
 - open
45
  in a repository context, open all which are found when the repository is
46
  created and leave open. when operating in an ephemeral environment, ensure
47
  open for the specific operation, but allow to close with the environment.
48
 - bound to a repository
49
  open together with the repository, allow to remain open and reuse
50
 - all db-specialized operators
51
  ensure that the database is open and leave the disposition to the transaction
52
  if the database was opened in a committed transaction, it will remain open
53
  untile the environment closes.
54
 
55
 there are three paths to retrieve the record for a given revision
56
 - ordinal -> record :
57
   the log_store aka revision-record database keys are ordinals
58
 - uuid -> ordinal -> record :
59
   the log_index (aka revision-ordinal-database maps uuid srings to ordinals
60
 - temporal (date-time, timestamp, etc) -> ordinal -> record :
61
   search the record database by timestamp to locate ordinal for the respective revision
62
 
63
 |#
64
 
65
 ;;; macros
66
 
67
 (defmacro rlmdb:with-open-repository ((repository &rest args) &body body)
68
   `(lmdb:with-environment (,repository ,@args) ,@body))
69
 
70
 
71
 ;;; operations
72
                                  
73
 (defgeneric repository-quad-pattern-index (repository quad-pattern)
74
   (:method-combination or)
75
 
76
   (:method or ((repository rlmdb::quad-index-repository) (quad-pattern t))
77
     (aref (repository-quad-databases repository) (quad-pattern-key-map-index quad-pattern)))
78
 
79
   (:method or ((repository rlmdb::temporal-index-repository) (pattern spocq:quad))
80
     (let ((predicate (spocq:quad-predicate pattern)))
81
       (when (position predicate (repository-temporal-predicates repository))
82
         (aref (repository-temporal-databases repository) (temporal-pattern-key-map-index pattern)))))
83
   (:method or ((repository rlmdb::temporal-index-repository) (pattern vector))
84
     (let ((predicate-id (predicate pattern)))
85
       (when (position predicate-id (repository-temporal-predicate-ids repository))
86
         (aref (repository-temporal-databases repository) (temporal-pattern-key-map-index pattern)))))
87
 
88
   (:method or ((repository rlmdb::time-series-index-repository) (pattern spocq:quad))
89
     (let ((predicate (spocq:quad-predicate pattern)))
90
       (when (position predicate (repository-time-series-predicates repository))
91
         (aref (repository-time-series-databases repository) (time-series-pattern-key-map-index pattern)))))
92
   (:method or ((repository rlmdb::time-series-index-repository) (pattern vector))
93
     (let ((predicate-id (predicate pattern)))
94
       (when (position predicate-id (repository-time-series-predicate-ids repository))
95
         (aref (repository-time-series-databases repository) (time-series-pattern-key-map-index pattern)))))
96
   )
97
 
98
 ;;; api
99
 
100
 (defgeneric rlmdb:get-metadata (designator)
101
   (:documentation "Given a repository - revisioned or not, retrieve the latest
102
    revision information from the meta db as a (key . value) a-list."))
103
 
104
 (defgeneric rlmdb:get-metadata-record (repository)
105
   (:documentation "Given a repository - revisioned or not, retrieve the latest
106
    revision information from the meta db as a record, which comprises just the
107
    ordinal, the uuid, and the commit timestamp."))
108
 
109
 ;;;!!! these need to resource the open environment
110
 ;;; https://github.com/LMDB/lmdb/blob/mdb.master/libraries/liblmdb/lmdb.h#L102
111
 ;;; or otherwise ensure that it is not opened more than once
112
 
113
 (defun rlmdb:get-metadata-ordinal (designator)
114
   (get-metadata-property designator "revision-id"))
115
 (defun rlmdb:get-metadata-timestamp (designator)
116
   (get-metadata-property designator "revision-time"))
117
 (defun rlmdb:get-metadata-uuid (designator)
118
   (get-metadata-property designator "revision-uuid"))
119
 (defun rlmdb:get-metadata-class (designator)
120
   (get-metadata-property designator "class"))
121
 (defun rlmdb:get-metadata-storage-class (designator)
122
   (get-metadata-property designator "storage-class"))
123
 
124
 (defun rlmdb:put-metadata-ordinal (designator value)
125
   (put-metadata-property designator :|revision-id| value))
126
 (defun rlmdb:put-metadata-timestamp (designator value)
127
   (put-metadata-property designator :|revision-time| value))
128
 (defun rlmdb:put-metadata-uuid (designator value)
129
   (put-metadata-property designator :|revision-uuid| value))
130
 (defun rlmdb:put-metadata-class (designator value)
131
   (put-metadata-property designator :|class| value))
132
 (defun rlmdb:put-metadata-storage-class (designator value)
133
   (put-metadata-property designator :|storage-class| value))
134
 
135
 (defgeneric rlmdb::put-metadata-record (repository record)
136
   (:documentation "Given a repository - revisioned or not, and a record, store its
137
    revision information into the meta db:
138
    ordinal, the uuid, and the commit timestamp."))
139
 
140
 (defgeneric rlmdb:find-revision-record (repository designator &key offset if-does-not-exist)
141
   (:documentation "Given a designator, resolve it against a repository to yield
142
    a revision record
143
    - as a distinguished value (eg 'HEAD'), and
144
    - as an integer, as a revision ordinal, and
145
    - as a uuid, against revision identifiers, and
146
    - as a temporal location, against revision commit timestamps.
147
    in all cases, allow a '~(N|P}' offset to indicate a relative revision.
148
 
149
    For a string designator, parse by syntax and proceed with the result.
150
    The base method accepts a revision record database and an ordinal integer.
151
    Auxiliary methods resolve a repository and designator variations, as required.
152
    The repository method establishes its transaction context, while the database
153
    method assumes the context exists.
154
 
155
    The api requires a repository context as various resolution methods cross among the
156
    respective databases. In this situation all databases will already have been opened.
157
 
158
    Values : revision-record
159
    "))
160
 
161
 (defun rlmdb:find-revision-ordinal (repository designator &rest args &key offset if-does-not-exist)
162
   "Return the ordinal value from the respective revision."
163
   (declare (dynamic-extent args)
164
            (ignore offset if-does-not-exist))
165
   (let ((record (apply #'rlmdb:find-revision-record repository designator args)))
166
     (when record (revision-record-ordinal record))))
167
 (defun rlmdb:find-revision-timestamp (repository designator &rest args &key offset if-does-not-exist)
168
   "Return the timestamp value from the respective revision."
169
   (declare (dynamic-extent args)
170
            (ignore offset if-does-not-exist))
171
   (let ((record (apply #'rlmdb:find-revision-record repository designator args)))
172
     (when record (revision-record-timestamp record))))
173
 (defun rlmdb:find-revision-uuid (repository designator &rest args &key offset if-does-not-exist)
174
   "Return the uuid value from the respective revision."
175
   (declare (dynamic-extent args)
176
            (ignore offset if-does-not-exist))
177
   (let ((record (apply #'rlmdb:find-revision-record repository designator args)))
178
     (when record (revision-record-uuid record))))
179
 
180
 
181
 (defgeneric rlmdb:get-revision-record (repository designator)
182
   (:argument-precedence-order designator repository)
183
   (:documentation "Given a direct designator, resolve it against a repository and
184
    return the identified revision record.
185
    If the record does not exist, return NIL
186
    "))
187
 
188
 (defgeneric rlmdb::revision-records (repository)
189
   (:documentation "Return the metadata for a repository's revisions as a list
190
    of revision records."))
191
 
192
 (defgeneric rlmdb:get-revision-records (repository)
193
   (:documentation "Read the metadata for a repository's revisions as a list
194
    of revision records.
195
    The sequence is sorted according to revision ordinal.
196
    This is in contrast to the inherent LMDB order as the u32->blob database is keyed by the u32
197
    ordinal value, which is stored on x** as little-endian and then ordered by LMDB in collation order,
198
    which means LSB first.
199
    Methods are defined for rlmdb internal classes and for a string repository designator."))
200
 
201
 (defgeneric rlmdb:get-revision-log-record (repository designator)
202
   (:argument-precedence-order designator repository)
203
   (:documentation "Given a direct designator, resolve it against a repository and
204
    return the identified revision log record.
205
    This extends the simple revison record to include the start time and counts.
206
    If the record does not exist, return NIL"))
207
 
208
 (defgeneric rlmdb:put-revision-record (repository record)
209
   (:argument-precedence-order repository record)
210
   (:documentation "Given a direct designator, resolve it against a repository and
211
    write the identified revision log record.
212
    This adds entries to both the ordinal->uuid and the uuid->record databases"))
213
 
214
 (defun rlmdb:get-revision-ordinal (repository identifier)
215
   "Return the ordinal of the identified revision via rlmdb:get-revision-record.
216
    Given an ordinal, this verifies that the record exists."
217
   (let ((record (rlmdb:get-revision-record repository identifier)))
218
     (when record (revision-record-ordinal record))))
219
 (defun rlmdb:get-revision-timestamp (repository identifier)
220
   "Return the timestamp of the identified revision via rlmdb:get-revision-record."
221
   (let ((record (rlmdb:get-revision-record repository identifier)))
222
     (when record (revision-record-timestamp record))))
223
 (defun rlmdb:get-revision-uuid (repository identifier)
224
   "Return the uuid of the identified revision via rlmdb:get-revision-record."
225
   (let ((record (rlmdb:get-revision-record repository identifier)))
226
     (when record (revision-record-uuid record))))
227
 
228
 (defun rlmdb:get-revision-timestamps (repository)
229
   "Return the list of repository revision timestamps.
230
    As retrieved from the store, these will be integer timestamps."
231
   (mapcar #'revision-record-timestamp
232
           (rlmdb:revision-records repository)))
233
 
234
 (defun rlmdb:get-revision-ordinals (repository)
235
   "Return the list of repository revision ordinals.
236
    As retrieved from the store, these will be integers."
237
   (mapcar #'revision-record-ordinal
238
           (rlmdb:revision-records repository)))
239
 
240
 (defun rlmdb:get-revision-uuids (repository)
241
   "Return the list of repository revision uuids.
242
    As retrieved from the store, these will be uuid objects."
243
   (mapcar #'revision-record-uuid
244
           (rlmdb:revision-records repository)))
245
 
246
 (defgeneric rlmdb:find-revision-ordinal-interval (repository &key first last if-does-not-exist)
247
   (:documentation "Given a repository and an interval, return the bounding
248
    revision records which correspond the repository state for those interval
249
    boundaries. The bounds may be expressed as some combination of
250
 
251
      (temporal-location x (temporal-location + duration)]
252
 
253
    Absent a bound, the respective extreme applies."))
254
 
255
 
256
 (defgeneric rlmdb:revision-record (object)
257
   (:documentation "Coerce the given object to a revision record.
258
    Given a designator, look up the record respective the current repository.")
259
   (:method ((object null))
260
     object)
261
   (:method ((record rlmdb:revision-record))
262
     record)
263
   (:method ((revision spocq.i::lmdb-revision))
264
     (spocq.i::repository-revision-record revision))
265
   (:method ((repository spocq.i:lmdb-repository))
266
     (rlmdb:revision-record (spocq.i:repository-lmdb-repository repository)))
267
   (:method ((repository rlmdb:repository))
268
     (rlmdb:get-metadata-record repository))
269
   (:method ((object t))
270
     (rlmdb:find-revision-record spocq.i:*repository* object)))
271
   
272
 
273
 ;;;
274
 ;;; interval
275
 
276
 (defmethod rlmdb:find-revision-ordinal-interval ((repository rlmdb:repository) &rest args)
277
   "Given a repository, establish the database context and continue."
278
   (declare (dynamic-extent args))
279
   (lmdb:with-transaction ((transaction (lmdb:make-transaction repository))
280
                            :initial-disposition :begin :normal-disposition :abort)
281
     (let ((revision-record-database (repository-revision-record-database repository)))
282
       (if revision-record-database
283
           (apply #'rlmdb:find-revision-ordinal-interval revision-record-database args)
284
           ;; if non-revisioned, return the current ordinal as a single value
285
           (let ((meta-database (repository-meta-database repository)))
286
             (values (rlmdb:get-metadata-ordinal meta-database)
287
                     nil))))))
288
 
289
 (defmethod rlmdb:find-revision-ordinal-interval ((database rlmdb:revision-record-database)
290
                                                  &key (first 0) (last nil) (offset nil)
291
                                                  (if-does-not-exist :error))
292
   (database-ordinal-interval database
293
                              first
294
                              (cond (last) (offset (location-plus-duration first offset)))
295
                              :if-does-not-exist if-does-not-exist))
296
 
297
                                 
298
 (defgeneric database-ordinal-interval (database first last &key if-does-not-exist)
299
   (:method ((database rlmdb:revision-record-database) (first spocq:temporal-location) (last spocq:temporal-location)
300
             &rest args)
301
     (declare (dynamic-extent args))
302
     (lmdb:ensure-open-database database)
303
     (let ((first-record (apply #'rlmdb:find-revision-record database first args))
304
           (last-record (apply #'rlmdb:find-revision-record database last args)))
305
       (when (and first-record last-record)
306
         (values (revision-record-ordinal first-record)
307
                 (revision-record-ordinal last-record)))))
308
   (:method ((database rlmdb:revision-record-database) (first  (eql :tail)) (last  (eql :head))
309
             &rest args)
310
     (declare (dynamic-extent args)
311
              (ignore args))
312
     (lmdb:ensure-open-database database)
313
     (values (rlmdb:find-first-ordinal database)
314
             (rlmdb:find-last-ordinal database)))
315
   (:method ((database rlmdb:revision-record-database) (first (eql :tail)) (last spocq:temporal-location)
316
             &rest args)
317
     (declare (dynamic-extent args))
318
     (lmdb:ensure-open-database database)
319
     (let ((last-record (apply #'rlmdb:find-revision-record database last args)))
320
       (when last-record
321
         (values (rlmdb:find-first-ordinal database)
322
                 (revision-record-ordinal last-record)))))
323
   (:method ((database rlmdb:revision-record-database) (first spocq:temporal-location) (last (eql :head))
324
             &rest args)
325
     (declare (dynamic-extent args))
326
     (lmdb:ensure-open-database database)
327
     (let ((first-record (apply #'rlmdb:find-revision-record database first args)))
328
       (when first-record
329
         (values (revision-record-ordinal first-record)
330
                 (rlmdb:find-last-ordinal database))))))
331
 
332
 
333
 
334
 ;;;
335
 ;;; metadata access
336
 
337
 (defmethod rlmdb:get-metadata ((name string))
338
   "given a string, interpret it as a repository name, resolve the link and proceed with the pathname"
339
   (rlmdb:get-metadata (spocq.i:repository name)))
340
 
341
 (defmethod rlmdb:get-metadata ((repository spocq.i:repository))
342
   "given a repository, interpret it as a repository name, resolve the link and proceed with the pathname"
343
   (rlmdb:get-metadata (spocq.i:repository-pathname repository)))
344
 
345
 (defmethod rlmdb:get-metadata ((repository spocq.i:lmdb-repository))
346
   "given a repository, interpret it as a repository name, resolve the link and proceed with the pathname"
347
   (rlmdb:get-metadata (spocq.i:repository-lmdb-repository repository)))
348
 
349
 (defmethod rlmdb:get-metadata ((location pathname))
350
   "Given a location, make a temporary environment with just the meta database and continue."
351
   (let ((environment (lmdb:make-environment location)))
352
     (lmdb:with-environment (environment)
353
       (lmdb:with-transaction ((txn (lmdb:make-transaction environment)))
354
         (let ((db (lmdb:make-database "meta" :class 'rlmdb:meta-database :repository environment)))
355
           (acons :database-names (rlmdb::get-database-names environment)
356
                  (rlmdb:get-metadata db)))))))
357
 
358
 (defmethod rlmdb:get-metadata ((repository rlmdb:repository))
359
   (lmdb:with-transaction ((transaction (lmdb:make-transaction repository))
360
                           :initial-disposition :begin :normal-disposition :abort)
361
     (acons :database-names (rlmdb::get-database-names repository)
362
            (rlmdb:get-metadata (repository-meta-database repository)))))
363
 
364
 (defmethod rlmdb:get-metadata ((meta-db rlmdb:meta-database))
365
   (let ((collection ()))
366
     (lmdb:ensure-open-database meta-db)
367
     (lmdb:do-pairs (meta-db key value)
368
                    (setf key (intern (map 'string #'code-char key) :keyword))
369
                    (push (cons key (rlmdb:decode-metadata key value)) collection))
370
     (reverse collection)))
371
 
372
 (defmethod spocq.i::storage-metadata ((repository rlmdb:repository))
373
   (rlmdb:get-metadata repository))
374
 
375
 
376
 (defgeneric rlmdb::get-database-names (context)
377
   (:method ((location pathname))
378
     "Given a location, make a temporary environment with just the meta database and continue."
379
     (rlmdb::get-database-names (lmdb:make-environment location)))
380
       
381
   (:method ((environment lmdb:environment))
382
     (lmdb:with-environment (environment)
383
       (lmdb:with-transaction ((transaction (lmdb:make-transaction environment))
384
                               :initial-disposition :begin :normal-disposition :abort)
385
         (let ((root-db (lmdb:make-database (cffi:null-pointer) :class 'lmdb:database))
386
               (names ()))
387
           (lmdb:ensure-open-database root-db)
388
           (lmdb:do-pairs (root-db key value)
389
                          (push (map 'string #'code-char key) names))
390
           (reverse names))))))
391
 
392
 (defgeneric rlmdb::get-repository-statistics (environment)
393
   (:documentation "return the composite database statics for the enviroment's
394
     databases. this includes at the meta databases and the index databases
395
     respective the structure.")
396
   (:method ((name string))
397
     (rlmdb::get-repository-statistics (spocq.i:repository name)))
398
   (:method ((repository spocq.i:lmdb-repository))
399
     (rlmdb::get-repository-statistics (spocq.i:repository-lmdb-repository repository)))
400
   (:method :around ((environment rlmdb:repository))
401
     (lmdb:with-transaction ((transaction (lmdb:make-transaction environment))
402
                             :initial-disposition :begin :normal-disposition :abort)
403
       (call-next-method)))
404
   (:method ((environment rlmdb:repository))
405
     (list (list* :name (repository-id environment)
406
                  :pathname (lmdb:environment-directory environment)
407
                  (append (lmdb:environment-statistics environment)
408
                          (lmdb:environment-info environment)))
409
           (list* :name "meta"
410
                  (lmdb:database-statistics (repository-meta-database environment) :transaction lmdb:*transaction*))))
411
   (:method ((environment rlmdb::revision-metadata-repository))
412
     (let ((revision-record-database (repository-revision-record-database environment))
413
           (revision-ordinal-database (repository-revision-ordinal-database environment)))
414
       (list* (list* :name (lmdb:database-name revision-ordinal-database)
415
                     (lmdb:database-statistics revision-ordinal-database :transaction lmdb:*transaction*))
416
              (list* :name (lmdb:database-name revision-record-database)
417
                     (lmdb:database-statistics revision-record-database :transaction lmdb:*transaction*))
418
              (call-next-method))))
419
   (:method ((environment rlmdb::quad-index-repository))
420
     (append (call-next-method)
421
             (loop for db across (repository-quad-databases environment)
422
               collect (list* :name (lmdb:database-name db)
423
                              (lmdb:database-statistics db :transaction lmdb:*transaction*)))))
424
   (:method ((repository rlmdb::temporal-index-repository))
425
     (append (call-next-method)
426
             (loop for db across (repository-temporal-databases repository)
427
               collect (list* :name (lmdb:database-name db)
428
                              (lmdb:database-statistics db :transaction lmdb:*transaction*)))))
429
   (:method ((repository rlmdb::time-series-index-repository))
430
     (append (call-next-method)
431
             (loop for db across (repository-time-series-databases repository)
432
               collect (list* :name (lmdb:database-name db)
433
                              (lmdb:database-statistics db :transaction lmdb:*transaction*))))))
434
 
435
 (defgeneric rlmdb::entry-count (designator)
436
   (:documentation "Determine the repository statement count as the count of
437
    entries in the first index.")
438
   
439
 
440
   (:method ((database lmdb:database))
441
     "given a database, presune a governing transaction and retrieve the entry count directly."
442
     (or (getf (lmdb:database-statistics database :transaction lmdb:*transaction*)
443
                 :entries)
444
           0)))
445
 
446
 
447
 (defmethod rlmdb:get-metadata-record ((location pathname))
448
   "Given a location, make a temporary environment with just the meta database and continue."
449
   (let ((env (lmdb:make-environment location)))
450
     (lmdb:with-environment (env)
451
       (lmdb:with-transaction ((txn (lmdb:make-transaction env)))
452
         (let ((db (lmdb:make-database "meta" :class 'rlmdb:meta-database)))
453
           (rlmdb:get-metadata-record db))))))
454
 
455
 (defmethod rlmdb:get-metadata-record ((repository rlmdb:repository))
456
   (lmdb:with-transaction ((transaction (lmdb:make-transaction repository))
457
                           :initial-disposition :begin :normal-disposition :abort)
458
     (rlmdb:get-metadata-record (repository-meta-database repository))))
459
 
460
 #+(or)
461
 (defmethod rlmdb:get-metadata-record ((meta-db rlmdb:meta-database))
462
   (lmdb:ensure-open-database meta-db)
463
   (let* ((id (lmdb:get meta-db "revision-id"))
464
          (uuid (lmdb:get meta-db "revision-uuid"))
465
          (timestamp (lmdb:get meta-db "revision-time")))
466
     (make-metadata-record :ordinal (if id (rlmdb:decode-metadata "revision-id" id) 0)
467
                           :uuid (if uuid (rlmdb:decode-metadata "revision-uuid" uuid) +null-uuid-string+)
468
                           :timestamp (if timestamp (rlmdb:decode-metadata "revision-time" timestamp) 0))))
469
 (defmethod rlmdb:get-metadata-record ((meta-db rlmdb:meta-database))
470
   (lmdb:ensure-open-database meta-db)
471
   (apply #'make-metadata-record
472
          (loop for (key . value) in (rlmdb:get-metadata meta-db)
473
            collect key collect value)))
474
 
475
 (defmethod rlmdb:get-metadata-record ((record-db rlmdb:index-database))
476
            "Given an index database, delegate to the respective meta database"
477
   (rlmdb:get-metadata-record (repository-meta-database (database-repository record-db))))
478
 
479
 (defmethod rlmdb:get-metadata-record ((record-db rlmdb:revision-record-database))
480
            "Given the revision record database, delegate to the respective meta database"
481
   (rlmdb:get-metadata-record (repository-meta-database (database-repository record-db))))
482
 
483
 (defmethod rlmdb:get-metadata-record ((repository spocq.i:lmdb-repository))
484
   (rlmdb:get-metadata-record (repository-lmdb-repository repository)))
485
 
486
 (defmethod rlmdb:get-metadata-record ((name string))
487
   (rlmdb:get-metadata-record (spocq.i:repository name)))
488
 
489
 (defmethod rlmdb:get-metadata-record ((repository spocq.i:repository))
490
   "Applied to a standard repository, this always returns NIL as, in that case, there
491
    are no metadata."
492
   nil)
493
 
494
 
495
 (defgeneric get-metadata-property (designator property)
496
   (:documentation "Read the given property from the repository metadata.
497
    Resolve given arguments to a metadata database and property key,
498
    retrieve the value from the database and decode it.
499
    Given an identifier, use the catalog location and a new environment rather
500
    than any registered instance.")
501
 
502
   (:method ((object null) property)
503
     "some resolution method failed"
504
     nil)
505
 
506
   (:method ((repository-id string) property)
507
     "given a string designator, interpret it as a repository name, derive the pathname and proceed with that."
508
     (let ((pathname (spocq.i::repository-catalog-pathname repository-id)))
509
       (assert pathname () (spocq.e:repository-not-found-error :identifier repository-id))
510
       (get-metadata-property pathname property)))
511
 
512
   (:method ((repository spocq.i:repository) property)
513
     "given a repository, interpret it as a repository name, resolve the link and proceed with the pathname"
514
     (get-metadata-property (spocq.i:repository-pathname repository) property))
515
 
516
   (:method ((repository spocq.i:lmdb-repository) property)
517
     "given an lmdb-repository, try the referent otherwise proceed with the pathname.
518
      as this is called during instantiation, the alternative may be necessary."
519
     (get-metadata-property (or (spocq.i:repository-lmdb-repository repository)
520
                                (spocq.i:repository-pathname repository))
521
                            property))
522
 
523
   (:method ((location pathname) property)
524
     "Given a location, make a temporary environment with just the meta database and continue."
525
     (let ((env (lmdb:make-environment location)))
526
       (lmdb:with-environment (env)
527
         (lmdb:with-transaction ((txn (lmdb:make-transaction env)))
528
           (let ((db (lmdb:make-database "meta" :class 'rlmdb:meta-database)))
529
             (get-metadata-property db property))))))
530
 
531
   (:method ((repository rlmdb:repository) property)
532
     (lmdb:with-transaction ((transaction (lmdb:make-transaction repository))
533
                             :initial-disposition :begin :normal-disposition :abort)
534
       (get-metadata-property (repository-meta-database repository) property)))
535
 
536
   (:method ((meta-db rlmdb:meta-database) (property symbol))
537
     (get-metadata-property meta-db (symbol-name property)))
538
   (:method ((meta-db rlmdb:meta-database) (property string))
539
     (lmdb:ensure-open-database meta-db)
540
     (let ((value (lmdb:get meta-db property)))
541
       (when value
542
         (rlmdb:decode-metadata property value))))
543
 
544
   (:method ((record-db rlmdb:index-database) property)
545
     "Given an index database, delegate to the respective meta database"
546
     (get-metadata-property (repository-meta-database (database-repository record-db)) property))
547
 
548
   (:method ((record-db rlmdb:revision-record-database) property)
549
     "Given the revision record database, delegate to the respective meta database"
550
     (get-metadata-property (repository-meta-database (database-repository record-db)) property)))
551
 
552
 
553
 (defmethod rlmdb::put-metadata-record ((location pathname) record)
554
   "Given a location, make a temporary environment with just the meta database and continue."
555
   (let ((env (lmdb:make-environment location)))
556
     (lmdb:with-environment (env)
557
       (lmdb:with-transaction ((txn (lmdb:make-transaction env :flags 0)))
558
         (let ((db (lmdb:make-database "meta" :class 'rlmdb:meta-database)))
559
           (rlmdb:put-metadata-record db record))))))
560
 
561
 (defmethod rlmdb:put-metadata-record ((repository rlmdb:repository) record)
562
   (lmdb:with-transaction ((transaction (lmdb:make-transaction repository))
563
                           :initial-disposition :begin :normal-disposition :abort)
564
     (rlmdb:put-metadata-record (repository-meta-database repository) record)))
565
 
566
 (defmethod rlmdb:put-metadata-record ((meta-db rlmdb:meta-database) (record rlmdb:metadata-record))
567
   (lmdb:ensure-open-database meta-db)
568
   (let* ((id (rlmdb:metadata-record-ordinal record))
569
          (uuid (rlmdb:metadata-record-uuid record))
570
          (time (rlmdb:metadata-record-timestamp record)))
571
     (assert (and id uuid time) ()
572
             "incomplete metadata record: ~s" record)
573
     (put-metadata-property meta-db "revision-id" id)
574
     (put-metadata-property meta-db "revision-uuid" (if (find-if #'upper-case-p uuid) (string-downcase uuid) uuid))
575
     (put-metadata-property meta-db "revision-time" time)))
576
 
577
 (defmethod rlmdb:put-metadata-record ((record-db rlmdb:index-database) (record rlmdb:metadata-record))
578
            "Given an index database, delegate to the respective meta database"
579
   (rlmdb:put-metadata-record (repository-meta-database (database-repository record-db)) record))
580
 
581
 (defmethod rlmdb:put-metadata-record ((record-db rlmdb:revision-record-database) (record rlmdb:metadata-record))
582
            "Given the revision record database, delegate to the respective meta database"
583
   (rlmdb:put-metadata-record (repository-meta-database (database-repository record-db)) record))
584
 
585
 (defmethod rlmdb:put-metadata-record ((repository spocq.i:lmdb-repository) (record rlmdb:metadata-record))
586
   (rlmdb:put-metadata-record (repository-lmdb-repository repository) record))
587
 
588
 (defmethod rlmdb:put-metadata-record ((name string) (record rlmdb:metadata-record))
589
   (rlmdb:put-metadata-record (spocq.i:repository name) record))
590
 
591
 (defmethod rlmdb:put-metadata-record ((repository spocq.i:repository) (record t))
592
   "Applied to a standard repository, this always returns NIL as, in that case, there
593
    are no metadata."
594
   nil)
595
 
596
 
597
 (defgeneric rlmdb:put-metadata-property (designator property value)
598
   (:documentation "Write the given property to the repository metadata.
599
    Resolve given arguments to a metadata database and property key, encode the value and
600
    write it to the database.
601
    Given an identifier, use the catalog location and a new environment rather
602
    than any registered instance.")
603
   
604
   (:method ((repository-id string) property value)
605
     "given a string designator, interpret it as a repository name, derive the pathname and proceed with that."
606
     (let ((pathname (spocq.i::repository-catalog-pathname repository-id)))
607
       (assert pathname () (spocq.e:repository-not-found-error :identifier repository-id))
608
       (rlmdb:put-metadata-property pathname property value)))
609
 
610
   (:method ((repository spocq.i:lmdb-repository) property value)
611
     "given a repository, delegate to the lmdb implementation"
612
     (rlmdb:put-metadata-property (spocq.i:repository-lmdb-repository repository) property value))
613
 
614
   (:method ((location pathname) property value)
615
     "Given a location, make a temporary environment with just the meta database and continue."
616
     (let ((env (lmdb:make-environment location)))
617
       (lmdb:with-environment (env)
618
         (lmdb:with-transaction ((txn (lmdb:make-transaction env :flags 0))
619
                                 :initial-disposition :begin :normal-disposition :commit)
620
           (let ((db (lmdb:make-database "meta" :class 'rlmdb:meta-database)))
621
             (rlmdb:put-metadata-property db property value))))))
622
 
623
   (:method ((repository rlmdb:repository) property value)
624
     (lmdb:with-transaction ((transaction (lmdb:make-transaction repository :flags 0))
625
                              :initial-disposition :begin :normal-disposition :commit)
626
       (rlmdb:put-metadata-property (repository-meta-database repository) property value)))
627
 
628
   (:method ((meta-db rlmdb:meta-database) (property symbol) value)
629
     (rlmdb:put-metadata-property meta-db (string property) value))
630
 
631
   (:method ((meta-db rlmdb:meta-database) (property string) value)
632
     (lmdb:ensure-open-database meta-db)
633
     (lmdb:put meta-db property (rlmdb:encode-metadata property value))))
634
 
635
 (defgeneric rlmdb:put-metadata (designator property-list)
636
   (:method ((repository-id string) property-list)
637
     "given a string designator, interpret it as a repository name, derive the pathname and proceed with that."
638
     (let ((pathname (spocq.i::repository-catalog-pathname repository-id)))
639
       (assert pathname () (spocq.e:repository-not-found-error :identifier repository-id))
640
       (rlmdb:put-metadata pathname property-list)))
641
   (:method ((repository spocq.i:lmdb-repository) property-list)
642
     "given a repository, delegate to the lmdb implementation"
643
     (rlmdb:put-metadata (spocq.i:repository-lmdb-repository repository) property-list))
644
   (:method ((location pathname) property-list)
645
     "Given a location, make a temporary environment with just the meta database and continue."
646
     (let ((env (lmdb:make-environment location)))
647
       (lmdb:with-environment (env)
648
         (lmdb:with-transaction ((txn (lmdb:make-transaction env :flags 0))
649
                                 :initial-disposition :begin :normal-disposition :commit)
650
           (let ((db (lmdb:make-database "meta" :class 'rlmdb:meta-database)))
651
             (rlmdb:put-metadata db property-list))))))
652
   (:method ((repository rlmdb:repository) property-list)
653
     (lmdb:with-transaction ((transaction (lmdb:make-transaction repository :flags 0))
654
                             :initial-disposition :begin :normal-disposition :commit)
655
       (rlmdb:put-metadata (repository-meta-database repository) property-list)))
656
 
657
   (:method ((meta-db rlmdb:meta-database) property-list)
658
     (loop for (property value) on property-list by #'cddr
659
       do (rlmdb:put-metadata-property meta-db property value))))
660
 
661
 
662
 
663
 (defgeneric rlmdb::entry-count (designator)
664
   (:documentation "Determine the repository statement count as the count of
665
    entries in the first index.")
666
   (:method ((name string))
667
     (rlmdb::entry-count (spocq.i:repository name)))
668
   (:method ((repository spocq.i:lmdb-repository))
669
     (rlmdb::entry-count (spocq.i:repository-lmdb-repository repository)))
670
 
671
   (:method ((repository rlmdb::quad-index-repository))
672
     (lmdb:with-transaction ((transaction (lmdb:make-transaction repository))
673
                             :initial-disposition :begin :normal-disposition :abort)
674
       ;; use the first index - they should all be the same
675
       (rlmdb::entry-count (aref (repository-quad-databases repository) 0))))
676
   (:method ((repository rlmdb::temporal-index-repository))
677
     (lmdb:with-transaction ((transaction (lmdb:make-transaction repository))
678
                             :initial-disposition :begin :normal-disposition :abort)
679
       ;; use the first index - they should all be the same
680
       (rlmdb::entry-count (aref (repository-temporal-databases repository) 0))))
681
   (:method ((repository rlmdb::time-series-index-repository))
682
     (lmdb:with-transaction ((transaction (lmdb:make-transaction repository))
683
                             :initial-disposition :begin :normal-disposition :abort)
684
       ;; use the first index - they should all be the same
685
       (rlmdb::entry-count (aref (repository-time-series-databases repository) 0))))
686
   (:method ((database lmdb:database))
687
     "given a database, presune a governing transaction and retrieve the entry count directly."
688
     (or (getf (lmdb:database-statistics database :transaction lmdb:*transaction*)
689
                 :entries)
690
           0)))
691
 
692
 
693
 
694
 ;;; revision records
695
 ;;; inexact designator resolution: offsets and temporal values
696
 
697
 #+(or)
698
 ;;; this logic fails with repositories which were revisioned, but are now not,
699
 ;;; the revision record database may have values, but they are not current.
700
 (defmethod rlmdb:find-revision-record ((repository rlmdb:repository) (designator t) &rest args
701
                                        &key (if-does-not-exist :error) offset)
702
   (declare (dynamic-extent args)
703
            (ignore offset))
704
   (let ((revision-record-database (repository-revision-record-database repository)))
705
     (cond (revision-record-database
706
            (lmdb:with-transaction ((transaction (lmdb:make-transaction repository))
707
                                    :initial-disposition :begin :normal-disposition :abort)
708
              (apply #'rlmdb:find-revision-record revision-record-database designator args)))
709
           (t
710
            (let ((record (rlmdb:get-metadata-record repository)))
711
              ;; if w/o revisions, permit head or match only
712
              (cond ((or (equal designator "HEAD") (eq designator :head))
713
                     record)
714
                    ((and record (and (stringp designator))
715
                          (string-equal designator (revision-record-uuid record)))
716
                     record)
717
                    (t
718
                     (signal-revision-not-found designator :if-does-not-exist if-does-not-exist))))))))
719
 
720
 (defmethod rlmdb:find-revision-record ((repository spocq.i:lmdb-repository) identifier &rest args)
721
   (declare (dynamic-extent args))
722
   (apply #'rlmdb:find-revision-record (spocq.i::repository-lmdb-repository repository) identifier args))
723
 
724
 (defmethod rlmdb:find-revision-record ((repository rlmdb:repository) (designator t) &rest args
725
                                        &key (if-does-not-exist :error) offset)
726
   "locate a revision record for a given id by first, check the metadata to match against head
727
    and if that fails, search the record database."
728
   (declare (dynamic-extent args))
729
   (let ((record (rlmdb:get-metadata-record repository)))
730
     ;; prospectively match the metadata record as head or exact match only 
731
     (cond ((and (or (equalp designator "HEAD") (eq designator :head))
732
                 (or (null offset) (typep offset '(integer 0))))
733
            record)
734
           ((and record (and (stringp designator))
735
                 (string-equal designator (revision-record-uuid record))
736
                 (or (null offset) (typep offset '(integer 0))))
737
            record)
738
           (t
739
            (let ((revision-record-database (repository-revision-record-database repository)))
740
              (cond (revision-record-database
741
                     (lmdb:with-transaction ((transaction (lmdb:make-transaction repository))
742
                                             :initial-disposition :begin :normal-disposition :abort)
743
                       (apply #'rlmdb:find-revision-record revision-record-database designator args)))
744
                    (t
745
                     (signal-revision-not-found designator :if-does-not-exist if-does-not-exist))))))))
746
 
747
 (defmethod rlmdb:find-revision-record ((repository rlmdb:repository) (revision-designator string)
748
                                        &rest args)
749
   (declare (dynamic-extent args)
750
            (ignore args))
751
   (if (string-equal "" revision-designator)
752
       (rlmdb:get-metadata-record repository)
753
       (call-next-method)))
754
 
755
 (defmethod rlmdb:find-revision-record ((repository rlmdb:repository) (revision-designator null)
756
                                        &rest args)
757
   (declare (dynamic-extent args)
758
            )
759
   (apply #'rlmdb:find-revision-record repository :head args))
760
 
761
 (defmethod rlmdb:find-revision-record ((database rlmdb:revision-record-database) (record rlmdb:revision-record)
762
                                        &rest args
763
                                        &key (if-does-not-exist :error) (offset nil))
764
   "This serves as the base method to locate revision information.
765
    It works from an intermediate result in the form of a revision record, given an
766
    offset to compute the respective revision
767
    For no offset, return the record as it stands."
768
   (declare (dynamic-extent args))
769
   (typecase offset
770
     ((or null (integer 0 0))
771
      ;; return the ordinal if it indicates a valid revision
772
      (if (rlmdb:is-valid-revision-record record)
773
          record
774
          (signal-revision-not-found record :if-does-not-exist if-does-not-exist)))
775
     (integer
776
      ;; return the the information for first the _valid_ revision at or beyond
777
      ;; the given ordinal offset
778
      (lmdb:ensure-open-database database)
779
      (let* ((limit (if (plusp offset) (rlmdb:get-metadata-ordinal database) 1)))
780
        (loop with increment = (signum offset)
781
          for test-ordinal = (+ (revision-record-ordinal record) offset) then (+ test-ordinal increment)
782
          for test-record = (rlmdb:get-revision-record database test-ordinal)
783
          until (or (when (minusp increment) (< test-ordinal limit))
784
                    (when (plusp increment) (> test-ordinal limit)))
785
          when (rlmdb:is-valid-revision-record test-record)
786
          do (return test-record)
787
          finally (return (apply #'signal-revision-not-found record args)))))
788
     (rlmdb:duration
789
      (if (zerop (rlmdb::temporal-timeline-location offset))
790
          record
791
          (let* ((offset-location (spocq.e:+ (rlmdb:timeline-location-date-time (revision-record-timestamp record))
792
                                             offset))
793
                 (duration-offset (rlmdb:temporal-timeline-location offset)))
794
            (rlmdb:find-revision-record database offset-location
795
                                        :if-does-not-exist if-does-not-exist
796
                                        :offset nil
797
                                        :first (if (minusp duration-offset) 1 (1+ (revision-record-ordinal record)))
798
                                        :last (if (minusp duration-offset) (1- (revision-record-ordinal record)) nil)))))
799
        
800
     (t
801
      (apply #'signal-invalid-revision-designator record args))))
802
 
803
 
804
 (defmethod rlmdb:find-revision-record ((database rlmdb:revision-record-database) (revision-designator (eql :head))
805
                                        &rest args)
806
   "For HEAD, return the latest revision information."
807
   (declare (dynamic-extent args))
808
   (let ((record (rlmdb:get-metadata-record database)))
809
     (if record 
810
         (apply #'rlmdb:find-revision-record database record args)
811
         (apply #'signal-revision-not-found revision-designator args))))
812
 
813
 (defmethod rlmdb:find-revision-record ((database rlmdb:revision-record-database) (revision-designator (eql :tail))
814
                                        &rest args)
815
   "for TAIL, return the earliest revision information"
816
   (declare (dynamic-extent args))
817
   ;; this requires special find logic. that might better be here?
818
   (let ((record (rlmdb:get-revision-record database 0)))
819
     (if record
820
         (apply #'rlmdb:find-revision-record database record args)
821
         (apply #'signal-revision-not-found revision-designator args))))
822
 
823
 (defmethod rlmdb:find-revision-record ((database rlmdb:revision-record-database) (revision-designator integer)
824
                                        &rest args)
825
   "For an integer, use it as an ordinal to retrieve the indicated record
826
    and then that for the offset revision."
827
   (declare (dynamic-extent args))
828
   (let ((record (rlmdb:get-revision-record database revision-designator)))
829
     (if record 
830
         (apply #'rlmdb:find-revision-record database record args)
831
         ;; even a non-existent ordinal is "not-found".
832
         (apply #'signal-revision-not-found revision-designator args))))
833
 
834
 (defmethod rlmdb:find-revision-record ((database rlmdb:revision-record-database) (revision-designator string)
835
                                        &rest args
836
                                        &key if-does-not-exist (offset 0))
837
   "Given a string designator, treat is as a uuid identifier, map the respective value to an record
838
    and then derive the respective relative (valid) record."
839
   (declare (dynamic-extent args))
840
   (labels ((find-by-uuid (uuid offset)
841
              (offset-record (rlmdb:get-revision-record database uuid) offset))
842
            (find-by-ordinal (ordinal offset)
843
              (offset-record (rlmdb:get-revision-record database ordinal) offset))
844
            (find-by-name (name offset)
845
              (rlmdb:find-revision-record database name :offset offset))
846
            (find-by-timestamp (temporal offset)
847
              (rlmdb:find-revision-record database temporal :offset offset))
848
            (offset-record (record offset)
849
              (if record
850
                  (if offset
851
                      (rlmdb:find-revision-record database record :if-does-not-exist if-does-not-exist :offset offset)
852
                      record)
853
                  (apply #'signal-revision-not-found revision-designator args))))
854
     (lmdb:ensure-open-database database)
855
     (multiple-value-bind (parsed-designator parsed-offset) (parse-revision-designator revision-designator)
856
       (let ((record (typecase parsed-designator
857
                       (string (find-by-uuid parsed-designator parsed-offset))
858
                       (keyword (find-by-name parsed-designator parsed-offset))
859
                       (rlmdb:temporal-location (find-by-timestamp parsed-designator parsed-offset))
860
                       (integer (find-by-ordinal parsed-designator parsed-offset))
861
                       (t (apply #'signal-invalid-revision-designator revision-designator args)))))
862
         (when record
863
           (if offset
864
               (apply #'rlmdb:find-revision-record database record args)
865
               record))))))
866
 
867
 (defmethod rlmdb:find-revision-record ((database rlmdb:revision-record-database) (revision-designator vector)
868
                                        &rest args)
869
   (declare (dynamic-extent args))
870
   (assert-argument-type rlmdb:find-revision-record revision-designator spocq.i::uuid-vector)
871
   (apply #'rlmdb:find-revision-record database (spocq.i::uuid-to-string revision-designator) args))
872
 
873
 (defmethod rlmdb:find-revision-record ((database rlmdb:revision-record-database) (revision-designator rlmdb:temporal-location)
874
                                        &rest args
875
                                        &key (if-does-not-exist :error) (offset nil) (first nil) (last nil))
876
   (declare (dynamic-extent args))
877
   (let ((location (rlmdb:temporal-timeline-location revision-designator)))
878
     (flet ((signal-invalid ()
879
              (apply #'signal-invalid-revision-designator revision-designator args))
880
            (signal-not-found ()
881
              (apply #'signal-revision-not-found revision-designator args))
882
            (return-record (record)
883
              (return-from rlmdb:find-revision-record
884
                (if offset
885
                    (rlmdb:find-revision-record database record 
886
                                                :if-does-not-exist if-does-not-exist :offset offset)
887
                    record)))
888
            (test-timestamp (timestamp)
889
              (cond ((< timestamp location) :test<location)
890
                    ((= timestamp location) :test=location)
891
                    (t :test>location))))
892
       (lmdb:ensure-open-database database)
893
       (let* ((location (rlmdb:temporal-timeline-location revision-designator))
894
              ;; rebind to shadow originals for use in signals
895
              (first (or first (rlmdb:find-first-ordinal database)))
896
              (last (or last (rlmdb:find-last-ordinal database)))
897
              (first-record (rlmdb:get-revision-record database first))
898
              (last-record (rlmdb:get-revision-record database last))
899
              )
900
         (cond ((not (and first-record last-record))
901
                (signal-invalid))
902
               ((< location (revision-record-timestamp first-record))
903
                (signal-not-found))
904
               ((>= location (revision-record-timestamp last-record))
905
                (return-record last-record))
906
               (t
907
                (loop for test-ordinal = (floor (/ (+ first last) 2))
908
                  for test-record = (or (rlmdb:get-revision-record database test-ordinal)
909
                                        (signal-invalid))
910
                  for test-relation = (test-timestamp (revision-record-timestamp test-record))
911
                  ;; do (print (list :first first :last last :test-ordinal test-ordinal :test-relation test-relation))
912
                  do (ecase test-relation
913
                       (:test=location (return-record test-record))
914
                       (:test<location
915
                        (if (= test-ordinal first)
916
                            (return-record first-record)
917
                            (setf first test-ordinal
918
                                  first-record test-record)))
919
                       (:test>location
920
                        (cond ((= test-ordinal first)
921
                               (signal-not-found))
922
                              ((= test-ordinal (1+ first))
923
                               (return-record first-record))
924
                              (t
925
                               (setf last test-ordinal
926
                                     last-record test-record))))))))))))
927
 
928
 (defmethod rlmdb:find-revision-record ((context t) (identifier uuid:uuid) &rest args)
929
   (declare (dynamic-extent args))
930
   (apply #'rlmdb:find-revision-record context (uuid:uuid-to-string identifier) args))
931
 
932
 (defmethod rlmdb:find-revision-record ((context t) (identifier spocq:uuid) &rest args)
933
   (declare (dynamic-extent args))
934
   (apply #'rlmdb:find-revision-record context (spocq:uuid-lexical-form identifier) args))
935
 
936
 
937
 ;;;
938
 ;;; direct access to revision record based on an ordinal or a uuid
939
 
940
 (defmethod rlmdb:get-revision-log-record ((repository rlmdb:repository) (ordinal integer))
941
   (let ((revision-record-database (repository-revision-record-database repository)))
942
     (when revision-record-database
943
       (lmdb:with-transaction ((transaction (lmdb:make-transaction repository))
944
                              :initial-disposition :begin :normal-disposition :abort)
945
         (rlmdb:get-revision-log-record revision-record-database ordinal)))))
946
 
947
 (defmethod rlmdb:get-revision-log-record ((record-db rlmdb:index-database) (ordinal integer))
948
            "Given an index database, delegate to the respective meta database"
949
   (rlmdb:get-revision-log-record (repository-meta-database (database-repository record-db))))
950
 
951
 
952
 (defmethod rlmdb:put-revision-record ((repository rlmdb::revision-metadata-repository) (record rlmdb:revision-log-record))
953
   "In an optional transaction context, add the revision records"
954
   (lmdb:with-transaction ((lmdb:transaction (lmdb:make-transaction repository :flags 0))
955
                           :initial-disposition :begin :normal-disposition :commit)
956
     (let ((revision-record-database (repository-revision-record-database repository))
957
           (revision-ordinal-database (repository-revision-ordinal-database repository)))
958
       (lmdb:ensure-open-database revision-ordinal-database)
959
       (lmdb:ensure-open-database revision-record-database)
960
       (cffi:with-foreign-object (%revision-record '(:struct log_record_v0))
961
         (%encode-revision-log-record record %revision-record)
962
         (cffi:with-foreign-object (%ordinal :uint32)
963
           (setf (cffi:mem-ref %ordinal :uint32) (revision-log-record-ordinal record))
964
           (with-lmdb-values ((%key 4 %ordinal) (%value +log_record_v0-size+ %revision-record))
965
             (liblmdb:put (lmdb::handle lmdb:transaction) (lmdb::handle revision-record-database) %key %value 0))
966
           (let ((%uuid (cffi:foreign-slot-pointer %revision-record '(:struct log_record_v0) 'transaction_uuid)))
967
             (with-lmdb-values ((%key spocq.i::+uuid-length+ %uuid) (%value 4 %ordinal))
968
               (liblmdb:put (lmdb::handle lmdb:transaction) (lmdb::handle revision-ordinal-database) %key %value 0))))))))
969
 
970
 (defgeneric rlmdb:put-repository-metadata (repository &key uuid ordinal end start)
971
   (:documentation "put all metadata respective transaction and repository form")
972
   (:method-combination progn)
973
   (:method :around ((repository rlmdb:repository) &rest args)
974
     (declare (ignore args))
975
     (lmdb:with-transaction ((transaction  (lmdb:make-transaction repository :flags 0))
976
                             :initial-disposition :begin :normal-disposition :commit)
977
       (call-next-method)
978
       (lmdb:transaction-id transaction)))
979
 
980
   (:method progn ((repository spocq.i:lmdb-repository) &rest args)
981
     (apply #'rlmdb:put-repository-metadata (spocq.i::repository-lmdb-repository repository) args))
982
 
983
   (:method progn ((repository rlmdb:repository) &key
984
                   (uuid (rlmdb:transaction-uuid lmdb:*transaction*))
985
                   (ordinal (lmdb:transaction-id lmdb:*transaction*))
986
                   (start (rlmdb:transaction-start lmdb:*transaction*))
987
                   (end (rlmdb:transaction-end lmdb:*transaction*)))
988
     (declare (ignore end))
989
     (let* ((meta-database (repository-meta-database repository)))
990
       (lmdb:ensure-open-database meta-database)
991
       (rlmdb:put-metadata-ordinal meta-database ordinal)
992
       (rlmdb:put-metadata-timestamp meta-database start)
993
       (rlmdb:put-metadata-uuid meta-database (string-downcase uuid))))
994
 
995
   ;; write entries in both the record and the ordinal databases
996
   ;; default succeed for lmdb-transactions only
997
   (:method progn ((repository rlmdb::revision-metadata-repository)
998
                   &key (uuid (rlmdb:transaction-uuid lmdb:*transaction*))
999
                   (ordinal (lmdb:transaction-id lmdb:*transaction*))
1000
                   (start (rlmdb:transaction-start lmdb:*transaction*))
1001
                   (end (rlmdb:transaction-end lmdb:*transaction*)))
1002
     (unless end
1003
       (setf (rlmdb:transaction-end lmdb:*transaction*)
1004
             (setf end (get-timeline-location))))
1005
     (let* ((uuid (string-downcase uuid))
1006
            (revision-record (make-revision-log-record :ordinal ordinal :uuid uuid :timestamp end :timestamp-begun start)))
1007
       (rlmdb:put-revision-record repository revision-record))))
1008
 #| duplicate
1009
            (revision-record-database (repository-revision-record-database repository))
1010
            (revision-ordinal-database (repository-revision-ordinal-database repository)))
1011
       (lmdb:ensure-open-database revision-ordinal-database)
1012
       (lmdb:ensure-open-database revision-record-database)
1013
       (cffi:with-foreign-object (%revision-record '(:struct log_record_v0))
1014
         (%encode-revision-log-record revision-record %revision-record)
1015
         (cffi:with-foreign-object (%ordinal :uint32)
1016
           (cffi:with-foreign-string (%uuid uuid)
1017
             (setf (cffi:mem-ref %ordinal :uint32) (revision-log-record-ordinal revision-record))
1018
             (with-lmdb-values ((%rr-key 4 %ordinal) (%rr-value +log_record_v0-size+ %revision-record)
1019
                                (%ro-key spocq.i::+uuid-length+ %uuid) (%ro-value 4 %ordinal))
1020
               (flet ((ck-lmdb (return-code)
1021
                        (unless (= return-code 0) (lmdb::unknown-error return-code))
1022
                        return-code))
1023
                 (ck-lmdb (liblmdb:put (lmdb::handle lmdb:*transaction*) (lmdb::handle revision-record-database) %rr-key %rr-value 0))
1024
                 (ck-lmdb (liblmdb:put (lmdb::handle lmdb:*transaction*) (lmdb::handle revision-ordinal-database) %ro-key %ro-value 0)))))))
1025
       revision-record)))
1026
 |#
1027
 
1028
 (defgeneric rlmdb:find-first-ordinal (revision-record-database)
1029
   (:documentation "Return the ordinal of the first revision. This will
1030
    be the first of the revision records - not the first record in the db.")
1031
   (:method ((repository rlmdb:repository))
1032
     (let ((records (rlmdb:revision-records repository)))
1033
       (when records
1034
           (revision-record-ordinal (first records)))))
1035
   (:method  ((repository spocq.i:lmdb-repository))
1036
     (rlmdb:find-first-ordinal (spocq.i:repository-lmdb-repository repository)))
1037
   (:method ((name string))
1038
     (rlmdb:find-first-ordinal (spocq.i:repository name)))
1039
   (:method ((db database))
1040
     (rlmdb:find-first-ordinal (database-repository db))))
1041
 
1042
 
1043
 #+(or) ;; this does not work as the index is ordered by byte comparison on little-endian integers
1044
 (defgeneric rlmdb:find-first-ordinal (revision-record-database)
1045
   (:method ((repository rlmdb:repository))
1046
     (let ((revision-record-database (repository-revision-record-database repository)))
1047
       (when revision-record-database
1048
         (lmdb:with-transaction ((transaction (lmdb:make-transaction repository))
1049
                                 :initial-disposition :begin :normal-disposition :abort)
1050
           (rlmdb:find-first-ordinal revision-record-database)))))
1051
 
1052
   (:method ((revision-record-database rlmdb:revision-record-database))
1053
     (lmdb:ensure-open-database revision-record-database)
1054
     (let ((cur (lmdb:make-cursor revision-record-database)))
1055
       (lmdb:with-cursor (cur)
1056
         (lmdb::with-empty-value (raw-key)
1057
           (lmdb::with-empty-value (raw-value)
1058
             (cffi:with-foreign-object (%zero-key :uint32)
1059
               (setf (cffi:mem-ref %zero-key :uint32) 0
1060
                     (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-size) (cffi:make-pointer 4)
1061
                     (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-data) %zero-key)
1062
               ;; :+first+ is also an option
1063
               (let ((return-code (liblmdb:cursor-get (lmdb::handle cur)
1064
                                                      raw-key
1065
                                                      raw-value
1066
                                                      :+set-range+)))
1067
                 (alexandria:switch (return-code)
1068
                                    (0
1069
                                     (cffi:mem-ref (cffi:foreign-slot-value raw-key '(:struct liblmdb:val) 'liblmdb:mv-data)
1070
                                                   :uint32))
1071
                                    (liblmdb:+notfound+
1072
                                     nil)
1073
                                    (t
1074
                                     (lmdb::unknown-error return-code)))))))))))
1075
 
1076
 (defun find-first-record (context)
1077
   (let ((ordinal (rlmdb:find-first-ordinal context)))
1078
     (when (typep ordinal '(integer 1))
1079
       (rlmdb:get-revision-record context ordinal))))
1080
 
1081
 (defgeneric rlmdb:find-last-ordinal (designator)
1082
   (:documentation "Return the last ordinal for the designated repository.
1083
    This is that of the latest revision.
1084
    It is one of the metadata properties.")
1085
   (:method ((designator t))
1086
     (rlmdb:get-metadata-ordinal designator)))
1087
 
1088
 (defun find-last-record (context)
1089
   (let ((ordinal (rlmdb:find-last-ordinal context)))
1090
     (when (typep ordinal '(integer 1))
1091
       (rlmdb:get-revision-record context ordinal))))
1092
 
1093
 ;;; abbreviated log record
1094
 
1095
 (defmethod rlmdb:get-revision-record ((repository rlmdb:repository) (ordinal integer))
1096
   (let ((revision-record-database (repository-revision-record-database repository)))
1097
     (when revision-record-database
1098
       (lmdb:with-transaction ((transaction (lmdb:make-transaction repository))
1099
                              :initial-disposition :begin :normal-disposition :abort)
1100
         (rlmdb:get-revision-record revision-record-database ordinal)))))
1101
 
1102
 (defmethod rlmdb:get-revision-record ((record-db rlmdb:index-database) (ordinal integer))
1103
            "Given an index database, delegate to the respective meta database"
1104
   (rlmdb:get-revision-record (repository-revision-record-database (database-repository record-db)) ordinal))
1105
 
1106
 (defmethod rlmdb:get-revision-record ((revision-record-database rlmdb:revision-record-database) (ordinal integer))
1107
   "The database method expects to execute within a transaction."
1108
   (labels ((decode-revision-record (k v)
1109
            (let* ((record (%decode-revision-record k v))
1110
                   (record-ordinal (revision-record-ordinal record)))
1111
              (assert (or (zerop ordinal) (= ordinal record-ordinal))  ;; special-case the first ordinal
1112
                      ()
1113
                      "Specified revision ordinal key does not match result: ~s ~s" ordinal record-ordinal)
1114
              record)))
1115
     (declare (dynamic-extent #'decode-revision-record))
1116
     (lmdb:ensure-open-database revision-record-database)
1117
     (if (zerop ordinal)
1118
         ;; where '0' is specified return the first one.
1119
         (find-first-record revision-record-database)
1120
         (lmdb::get-with revision-record-database ordinal #'decode-revision-record))))
1121
 
1122
 (defmethod rlmdb:get-revision-record ((repository rlmdb::revision-metadata-repository) (identifier vector))
1123
   "Given a vector, use it as a uuid key into the uuid->ordinal database."
1124
   (let ((revision-ordinal-database (repository-revision-ordinal-database repository)))
1125
     (lmdb:with-transaction ((transaction (lmdb:make-transaction repository))
1126
                             :initial-disposition :begin :normal-disposition :abort)
1127
       (rlmdb:get-revision-record revision-ordinal-database identifier))))
1128
 
1129
 (defmethod rlmdb:get-revision-record ((repository rlmdb::repository) (identifier vector))
1130
   "If there is no revision metadata, return nil."
1131
   nil)
1132
 
1133
 (defmethod rlmdb:get-revision-record ((database rlmdb:revision-ordinal-database) (identifier vector))
1134
   "Given a vector, interpret it as a uuid byte array, and proceed with that."
1135
   (lmdb:ensure-open-database database)
1136
   (let ((ordinal (lmdb:get database identifier)))
1137
     (when ordinal
1138
       (rlmdb:get-revision-record (repository-revision-record-database database)
1139
                                  (rlmdb:decode-metadata :|revision-id| ordinal)))))
1140
 
1141
 (defmethod rlmdb:get-revision-record ((context rlmdb::database) (identifier vector))
1142
   (rlmdb:get-revision-record (database-repository context) identifier))
1143
 
1144
 (defmethod rlmdb:get-revision-record ((name string) (identifier t))
1145
   (rlmdb:get-revision-record (spocq.i:repository name) identifier))
1146
 
1147
 (defmethod rlmdb:get-revision-record ((repository spocq.i:lmdb-repository) (identifier t))
1148
   (rlmdb:get-revision-record (spocq.i:repository-lmdb-repository repository) identifier))
1149
 
1150
 (defmethod rlmdb:get-revision-record ((context t) (identifier string))
1151
   "Given a string, transform it into a case-independent uuid byte array, and proceed with that."
1152
   (rlmdb:get-revision-record context (uuid:string-to-byte-array identifier)))
1153
 
1154
 (defmethod rlmdb:get-revision-record ((context t) (identifier uuid:uuid))
1155
   "Given a spocq:uuid, transform it into a case-independent uuid byte array, and proceed with that."
1156
   (rlmdb:get-revision-record context (uuid:uuid-to-byte-array identifier)))
1157
 
1158
 (defmethod rlmdb:get-revision-record ((context t) (identifier spocq:uuid))
1159
   "Given a uuid:uuid, transform it into a uuid byte array, and proceed with that."
1160
   (rlmdb:get-revision-record context (uuid:string-to-byte-array (spocq:uuid-lexical-form identifier))))
1161
 
1162
 ;;; full log record
1163
 (defmethod rlmdb:get-revision-log-record ((revision-record-database rlmdb:revision-record-database) (ordinal integer))
1164
   "The database method expects to execute within a transaction."
1165
   (labels ((decode-revision-log-record (k v)
1166
              (let ((record (%decode-revision-log-record (%mdb-val-data v)))
1167
                    (record-ordinal (cffi:mem-ref (%mdb-val-data k) :uint32)))
1168
                (assert (or (zerop ordinal) (= ordinal record-ordinal))  ;; special-case the first ordinal
1169
                        ()
1170
                        "Specified revision ordinal key does not match result: ~s ~s" ordinal record-ordinal)
1171
                (setf (revision-log-record-ordinal record) record-ordinal)
1172
                record)))
1173
     (declare (dynamic-extent #'decode-revision-log-record))
1174
     (lmdb:ensure-open-database revision-record-database)
1175
     (if (zerop ordinal)
1176
         ;; where '0' is specified return the first one.
1177
         (find-first-record revision-record-database)
1178
         (lmdb::get-with revision-record-database ordinal #'decode-revision-log-record))))
1179
 
1180
 (defmethod rlmdb:get-revision-log-record ((repository rlmdb::revision-metadata-repository) (identifier vector))
1181
   "Given a vector, use it as a uuid key into the uuid->ordinal database."
1182
   (let ((revision-ordinal-database (repository-revision-ordinal-database repository)))
1183
     (lmdb:with-transaction ((transaction (lmdb:make-transaction repository))
1184
                             :initial-disposition :begin :normal-disposition :abort)
1185
       (rlmdb:get-revision-log-record revision-ordinal-database identifier))))
1186
 
1187
 (defmethod rlmdb:get-revision-log-record ((database rlmdb:revision-ordinal-database) (identifier vector))
1188
   "Given a vector, interpret it as a uuid byte array, and proceed with that."
1189
   (lmdb:ensure-open-database database)
1190
   (let ((ordinal (lmdb:get database identifier)))
1191
     (when ordinal
1192
       (rlmdb:get-revision-log-record (repository-revision-record-database database)
1193
                                  (rlmdb:decode-metadata :|revision-id| ordinal)))))
1194
 
1195
 (defmethod rlmdb:get-revision-log-record ((repository rlmdb::repository) (identifier vector))
1196
   "If there is no revision metadata, return nil."
1197
   nil)
1198
 
1199
 (defmethod rlmdb:get-revision-log-record ((context t) (identifier string))
1200
   "Given a string, transform it into a uuid byte array, and proceed with that."
1201
   ;; conversion to byte array is case-independent
1202
   (rlmdb:get-revision-log-record context (uuid:string-to-byte-array identifier)))
1203
 
1204
 (defmethod rlmdb:get-revision-log-record ((context t) (identifier uuid:uuid))
1205
   "Given a spocq:uuid, transform it into a uuid byte array, and proceed with that."
1206
   (rlmdb:get-revision-log-record context (uuid:uuid-to-byte-array identifier)))
1207
 
1208
 (defmethod rlmdb:get-revision-log-record ((context t) (identifier spocq:uuid))
1209
   "Given a uuid:uuid, transform it into a uuid byte array, and proceed with that."
1210
   ;; conversion to byte array is case-independent
1211
   (rlmdb:get-revision-log-record context (uuid:string-to-byte-array (spocq:uuid-lexical-form identifier))))
1212
 
1213
 (defmethod rlmdb:get-revision-log-record ((context rlmdb::database) (identifier vector))
1214
   (rlmdb:get-revision-record (database-repository context) identifier))
1215
 
1216
 (defmethod rlmdb:get-revision-log-record ((name string) (identifier t))
1217
   (rlmdb:get-revision-log-record (spocq.i:repository name) identifier))
1218
 
1219
 (defmethod rlmdb:get-revision-log-record ((repository spocq.i:lmdb-repository) (identifier t))
1220
   (rlmdb:get-revision-log-record (spocq.i:repository-lmdb-repository repository) identifier))
1221
 
1222
 
1223
 ;;;
1224
 ;;; complete revision history
1225
 
1226
 (defmethod rlmdb:revision-records ((repository rlmdb:repository))
1227
   (let ((txn-id (rlmdb::get-environment-info-last-transaction-id repository)))
1228
     (or (and (eql (rlmdb::repository-last-transaction-id repository) txn-id)
1229
              (rlmdb::repository-revision-records repository))
1230
         (prog1 (setf (rlmdb::repository-revision-records repository)
1231
                      (rlmdb:get-revision-records repository))
1232
           (setf (rlmdb::repository-last-transaction-id repository)
1233
                 txn-id)))))
1234
 
1235
 (defmethod rlmdb:revision-records ((name string))
1236
   (rlmdb:revision-records (spocq.i:repository name)))
1237
 
1238
 (defmethod rlmdb:revision-records ((repository spocq.i:lmdb-repository))
1239
   (rlmdb:revision-records (spocq.i:repository-lmdb-repository repository)))
1240
 
1241
 
1242
 (defmethod rlmdb:get-revision-records ((repository rlmdb:repository))
1243
   (let ((revision-record-database (repository-revision-record-database repository)))
1244
     (when revision-record-database
1245
       (lmdb:with-transaction ((transaction  (lmdb:make-transaction repository))
1246
                                :initial-disposition :begin :normal-disposition :abort)
1247
         (rlmdb:get-revision-records revision-record-database)))))
1248
 
1249
 (defmethod rlmdb:get-revision-records ((revision-record-database rlmdb:revision-record-database))
1250
   "read the records and sort by id in ascending order.
1251
  This makes the first ordinal readily available, while the last ordinal is
1252
  is in the metadata."
1253
   (sort (collect-list (collect)
1254
                       (lmdb:ensure-open-database revision-record-database)
1255
                       (labels ((decode-revision-record (k v)
1256
                                  (let ((record (%decode-revision-record k v)))
1257
                                    (values (revision-record-ordinal record) record))))
1258
                         (lmdb::do-pairs-with (revision-record-database id record #'decode-revision-record)
1259
                                              (collect record))))
1260
         #'< :key #'rlmdb:revision-record-ordinal))
1261
 
1262
 (defmethod rlmdb:get-revision-records ((name string))
1263
   (rlmdb:get-revision-records (spocq.i:repository name)))
1264
 
1265
 (defmethod rlmdb:get-revision-records ((repository spocq.i:lmdb-repository))
1266
   (rlmdb:get-revision-records (spocq.i:repository-lmdb-repository repository)))
1267
 
1268
 
1269
 (defmethod rlmdb:get-revision-log-records ((repository rlmdb:repository))
1270
   (let ((revision-record-database (repository-revision-record-database repository)))
1271
     (when revision-record-database
1272
       (lmdb:with-transaction ((transaction  (lmdb:make-transaction repository))
1273
                                :initial-disposition :begin :normal-disposition :abort)
1274
         (rlmdb:get-revision-log-records revision-record-database)))))
1275
 
1276
 (defmethod rlmdb:get-revision-log-records ((revision-record-database rlmdb:revision-record-database))
1277
   (collect-list (collect)
1278
     (lmdb:ensure-open-database revision-record-database)
1279
     (labels ((decode-revision-log-record (k v)
1280
                (let ((record (%decode-revision-log-record (%mdb-val-data v))))
1281
                  (setf (revision-log-record-ordinal record) (cffi:mem-ref (%mdb-val-data k) :uint32))
1282
                  (values (revision-record-ordinal record) record))))
1283
       (lmdb::do-pairs-with (revision-record-database id record #'decode-revision-log-record)
1284
         (collect record)))))
1285
 
1286
 (defmethod rlmdb:get-revision-log-records ((name string))
1287
   (rlmdb:get-revision-log-records (spocq.i:repository name)))
1288
 
1289
 (defmethod rlmdb:get-revision-log-records ((repository spocq.i:lmdb-repository))
1290
   (rlmdb:get-revision-log-records (spocq.i:repository-lmdb-repository repository)))
1291
 
1292
 
1293
 (defgeneric rlmdb::get-environment-info (repository)
1294
   (:method ((repository rlmdb:repository))
1295
     (lmdb:environment-info repository))
1296
   (:method ((name string))
1297
     (rlmdb::get-environment-info (spocq.i:repository name)))
1298
   (:method ((repository spocq.i:lmdb-repository))
1299
     (rlmdb::get-environment-info (spocq.i:repository-lmdb-repository repository))))
1300
 
1301
 (defgeneric rlmdb::get-environment-info-last-transaction-id (repository)
1302
   (:documentation "return the current lmdb transaction id.
1303
    this is read-only, as the data is copied out of the opaque environment and no
1304
    capbility is defined to copy back.
1305
    nb. mdb#mdb_env_write_meta which writes the txn number back")
1306
   (:method ((repository rlmdb:repository))
1307
     (lmdb:environment-info-last-transaction-id repository))
1308
   (:method ((name string))
1309
     (rlmdb::get-environment-info-last-transaction-id (spocq.i:repository name)))
1310
   (:method ((repository spocq.i:lmdb-repository))
1311
     (rlmdb::get-environment-info-last-transaction-id (spocq.i:repository-lmdb-repository repository))))
1312