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

KindCoveredAll%
expression7161655 43.3
branch43136 31.6
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.spocq.implementation)
4
 
5
 (:documentation "SPOCQ lmdb extensions"
6
                 "Specialize repository, revision and transaction classes
7
  to refer to rlmdb wrappers for lmdb entities.
8
  Class definitions are in core/rlmdb.
9
 
10
  * classes
11
  - lmdb-repository : binds a rlmdb:repository instance
12
    as a reference to the respective lmdb environment and to its databases.
13
    Open the environment when initializing and close it when finalizing.
14
    This remains the only reference to the environment - all others use
15
    it, but do not modify its condition.
16
    The storage schema is specified as the storage-class, which is one of
17
    - rlmdb:repository : spog indices, when contingently revisioned with cardinality maps
18
    - rlmdb:temporal-repository : revision-identifier to quad graph index, spog ignored
19
    - rlmdb:replicable-repository : spog indices with revision-identifier maps
20
  - lmdb-revision : specialized in order to use an lmdb-transaction.
21
    binds also the respective repository's lmdb-repository, but does not
22
    change the condition
23
  - lmdb-transaction : specialized in order to bind a reference to the
24
    lmdb repository, from which the environment is then used to establish an
25
    lmdb transaction, as required.
26
 
27
  * processing
28
  The lmdb practice is that an environment remain open for a process' duration.
29
  On the other hand, each must be closed in order to release lmdb resources,
30
  which are otherwise eventually exhausted. This occurs in terms of either
31
  environments or databases at a relatively low limit.
32
  The practice is also that a database be opened on the first occasion and then
33
  remain open until the environment is closed. In order to effect this, the
34
  respective transaction must be committed - even when it is read-only, while
35
  the database remain open, after which the database is re-used in other
36
  transactions.
37
  The practice with transactions is that they are created on-demand and must be
38
  closed in order to release cursors - whereby cursors in a read-only
39
  transaction must be closed explicitly.
40
 
41
  This leads to the following pattern:
42
  task
43
  -> spocq:lmdb-repository
44
     -> rlmdb:repository :
45
        -> lmdb:environment : finalize closes lmdb entity iff still open
46
  -> spocq:lmdb-revision
47
     -> spocq:lmdb-repository
48
     -> rlmdb:repository : cloned from its referent repository
49
  -> spocq:lmdb-transaction : destroy transaction closes
50
     -> lmdb:transaction
51
 
52
  This leads to two different processing patterns
53
  - with-open-
54
  - ensure-open-
55
 
56
  the former arranges for the lmdb entity to have dynamic extent: the entity is
57
  created/opened, as needed, upon entry and closed/destroyed upon exit iff it
58
  was created/opened
59
  the latter arranges for the entity to have indefinite extent: the entity is
60
  created/opened, as needed, upon entry, but left intact upon exit.
61
 
62
  this is reflected in individual operations as follows:
63
  - autonomous operations use with-open-transaction.
64
  this creates and manages a dynamic transaction for the cases where it should
65
  be closed. eg. when opening the repository, the transaction must be closed in
66
  order to afford the repository databases indefinite extent.
67
  - retrieval operation use ensure-open-transaction with the single
68
  lmdb:transaction bound into the spocq transaction.
69
  this creates an lmdb entity with indefinite extent which is reused for all
70
  get/put/cursor operations to cause all to use the same lmdb state.
71
 
72
  access operations must support two modes:
73
  - in the context of an lmdb-repository, establish a dynamic transaction
74
  wrt the lmdb environment for the databases to reuse. commit it at the
75
  conclusion in order to leave them intact.
76
  - in the context of an lmdb-transaction, use its lmdb entity directly 
77
  for databases and leave it unchanged at the conclusion.
78
 
79
  The constaint on environment extent affects the logic in
80
  initialize-repository-storage. It mus take case to close the environment
81
  which is uses to create the sub-databases.
82
  If it is not, it is observed that the access to the revision information
83
  for a subsequently instantiated repository's environment will yield, of all
84
  things, the record from the meta database of the <account>/system repository,
85
  which had been accessed immediatly prior.
86
  The lmdb [documantation](http://www.lmdb.tech/doc/) does advise:
87
     'Do not have open an LMDB database twice in the same process at the same time.'
88
  but it does not indicate that the behaviour is that poorly defined.
89
 ")
90
 
91
 
92
 (defmethod make-ephemeral-repository (&rest args)
93
   (apply #'make-instance 'lmdb-ephemeral-repository
94
          :open-flags (+ LIBLMDB:+NOTLS+ LIBLMDB:+NOSYNC+)         
95
          args))
96
 
97
 (defmethod initialize-instance :after ((instance lmdb-repository) &rest initargs)
98
   (declare (dynamic-extent initargs))
99
   ;;; class-llocate this
100
   ;;; check for a special storage class before creating the instance
101
   ;;; (setf-repository-storage-class (repository-storage-class instance) instance)
102
   (let ((rlmdb:repository (apply #'compute-reference-lmdb-repository instance initargs)))
103
     (rlmdb:open-repository rlmdb:repository)
104
     (setf-repository-lmdb-repository rlmdb:repository instance)))
105
 
106
 (defmethod clear-repository ((repository lmdb-repository) &rest args)
107
   (apply #'rlmdb:clear-repository (repository-lmdb-repository repository) args))
108
 
109
 (defmethod repository-last-revision ((repository lmdb-repository))
110
   (rlmdb:find-last-ordinal repository))
111
 
112
 (defmethod repository-write-date ((repository lmdb-repository))
113
   "return the universal time for the last write"
114
   (let* ((timestamp (rlmdb:get-metadata-timestamp repository)))
115
     (when timestamp
116
       (rlmdb:timeline-location-date-time timestamp))))
117
 
118
 (defmethod repository-write-timestamp ((repository lmdb-repository))
119
   "return the universal time for the last write"
120
   (rlmdb:get-metadata-timestamp repository))
121
 
122
 (defmethod repository-object-term-number ((repository lmdb-repository) object)
123
   (rlmdb:value-term-number object))
124
 
125
 
126
 (defmethod compute-reference-lmdb-repository ((repository lmdb-repository) &rest args
127
                                               &key
128
                                               (repository-id (repository-id repository))
129
                                               &allow-other-keys)
130
   ;; construct an lmdb environment with reference to this repository 
131
   ;; open it once for the base repository
132
   (let ((rlmdb:repository (apply #'make-instance (repository-storage-class repository)
133
                                  :repository-id repository-id
134
                                  args)))
135
     rlmdb:repository))
136
 
137
 (defmethod resolve-repository-revision-id ((repository lmdb-repository) &key (revision "HEAD") (if-does-not-exist :error))
138
   (let* ((lmdb-repository (repository-lmdb-repository repository))
139
          (uuid (if (typecase revision
140
                      (string (equalp revision "HEAD"))
141
                      (null t)
142
                      (symbol (eql revision :head)))
143
                    (rlmdb:get-metadata-uuid lmdb-repository)  ;; should always return something
144
                    (rlmdb:find-revision-uuid lmdb-repository revision :if-does-not-exist if-does-not-exist))))
145
     (when uuid
146
       (string-downcase uuid))))
147
 
148
 
149
 (defmethod compute-reference-lmdb-repository ((reference repository-revision) &key
150
                                               &allow-other-keys)
151
   ;; copy the instance from the respective revision's referent repository
152
   ;; do not re-open
153
   (repository-lmdb-repository (repository-revision-reference reference)))
154
 
155
 ;; given the above, not strictly necessary
156
 (defmethod repository-lmdb-repository ((revision repository-revision))
157
   (repository-lmdb-repository (repository-revision-reference revision)))
158
 
159
 (defmethod repository-write-date ((repository lmdb-revision))
160
   "return the universal time for the revision end timestamp"
161
   (repository-revision-write-date repository (repository-revision-id repository)))
162
 
163
 (defmethod repository-write-timestamp ((repository lmdb-revision))
164
   "return the universal time for the revision end timestamp"
165
   (repository-revision-write-timestamp repository (repository-revision-id repository)))
166
 
167
 (defmethod repository-revision-write-date ((repository lmdb-repository) (revision-id string))
168
   (let* ((timestamp (rlmdb:get-revision-timestamp repository revision-id)))
169
     (when timestamp
170
       (rlmdb:timeline-location-date-time timestamp))))
171
 
172
 (defmethod repository-revision-write-timestamp ((repository lmdb-repository) (revision-id string))
173
   (rlmdb:get-revision-timestamp repository revision-id))
174
 
175
 (defmethod revision-relation ((revision lmdb-revision))
176
   "The default relation ensures the statement visibility includes the specified location.
177
   Where just the start is specified, that serves also as the end."
178
   (or (call-next-method)
179
       (setf (revision-relation revision)
180
             (let ((min-id (revision-min-revision-ordinal revision))
181
                   (max-id (revision-max-revision-ordinal revision)))
182
               (if (null max-id)
183
                   `(|time|::|versionIncludes| ,min-id ,min-id)
184
                   `(|time|::|versionIncludes| ,min-id ,max-id))))))
185
 
186
 
187
 (defmethod initialize-instance ((instance lmdb-transaction) &rest initargs
188
                                 &key revision
189
                                 (min-revision-ordinal (revision-min-revision-ordinal revision))
190
                                 (max-revision-ordinal (or (revision-max-revision-ordinal revision) min-revision-ordinal)))
191
   (declare (dynamic-extent initargs))
192
   (apply #'call-next-method instance
193
          :min-revision-ordinal min-revision-ordinal
194
          :max-revision-ordinal max-revision-ordinal
195
          initargs)
196
   (setf-transaction-lmdb-transaction nil instance))
197
 #|
198
   (when (transaction-read-only-p instance)
199
     (let* ((rlmdb:repository (repository-lmdb-repository revision))
200
            (lmdb:transaction (lmdb:make-transaction rlmdb:repository)))
201
       ;; created, but not opened
202
       (setf-transaction-lmdb-transaction lmdb:transaction instance))))
203
 |#
204
 
205
 (defun revision-max-uuid () (rlmdb:revision-record-uuid (transaction-max-revision-record *transaction*)))
206
 (defun revision-min-uuid () (rlmdb:revision-record-uuid (transaction-min-revision-record *transaction*)))
207
 (defun revision-max-timestamp () (rlmdb:revision-record-uuid (transaction-max-revision-record *transaction*)))
208
 (defun revision-min-timestamp () (rlmdb:revision-record-uuid (transaction-min-revision-record *transaction*)))
209
 (defun revision-max-ordinal () (transaction-max-revision-ordinal *transaction*))
210
 (defun revision-min-ordinal () (transaction-min-revision-ordinal *transaction*))
211
 
212
 (defmethod rlmdb:get-revision-record ((transaction lmdb-transaction) ordinal)
213
   (rlmdb:get-revision-record (transaction-lmdb-repository transaction) ordinal))
214
 
215
 (defgeneric revision-max-revision-id (revision)
216
   (:method ((revision lmdb-revision))
217
     (let ((record (revision-max-revision-record revision)))
218
       (when record
219
         (rlmdb:revision-record-uuid record))))
220
   (:method ((revision repository-revision))
221
     (repository-revision-id revision)))
222
 
223
 (defgeneric revision-min-revision-id (revision)
224
   (:method ((revision lmdb-revision))
225
     (let ((record (revision-min-revision-record revision)))
226
       (when record
227
         (rlmdb:revision-record-uuid record))))
228
   (:method ((revision repository-revision))
229
     (repository-revision-id revision)))
230
 
231
 (defmethod destroy-transaction ((transaction lmdb-transaction))
232
   ;;There is no locking here, as the generic function handles it.
233
   (call-next-method)
234
   (let ((lmdb:transaction (transaction-lmdb-transaction transaction)))
235
     (when (lmdb:open-p lmdb:transaction)
236
       ;; if at this point it is still open, abort it
237
       (lmdb:abort-transaction lmdb:transaction))))
238
 
239
 (defmethod transaction-write-event ((transaction lmdb-transaction))
240
   "In this case, rdfcache still handles the write transaction - even for revisioned repositories.
241
   This means it has written the metadata and revision log records."
242
   (let* ((revision-id (transaction-id transaction))
243
          (repository (transaction-repository transaction))
244
          (agent (when *task* (task-agent *task*)))
245
          (agent-id (agent-name agent))
246
          (agent-tag (when *task* (task-user-tag *task*))))
247
     (flet ((ste (start-time end-time insert remove)
248
              (store-transaction-event :revision-id revision-id
249
                                       :task-id (or (task-id *task*) revision-id)
250
                                       :timestamp-start start-time
251
                                       :timestamp-end end-time
252
                                       :repository repository
253
                                       :agent agent-id
254
                                       :agent-tag agent-tag
255
                                       :inserted insert
256
                                       :removed remove)))
257
       (if (repository-is-revisioned repository)
258
           (let* ((rlr (rlmdb:get-revision-log-record repository revision-id)))
259
             (if rlr
260
                 (ste (when rlr (timeline-location-date-time (rlmdb:revision-log-record-timestamp-begun rlr)))
261
                      (when rlr (timeline-location-date-time (rlmdb:revision-log-record-timestamp rlr)))
262
                      (when rlr (rlmdb:revision-log-record-inserted-count rlr))
263
                      (when rlr (rlmdb:revision-log-record-removed-count rlr)))
264
                 (log-warn "transaction-write-record: no revision log record: ~s ~s" repository revision-id)))
265
           (let* ((mr (rlmdb:get-metadata-record repository)))
266
             (if mr
267
                 (let ((timestamp (timeline-location-date-time (rlmdb:metadata-record-timestamp mr))))
268
                   (ste timestamp timestamp nil nil))
269
                 (log-warn "transaction-write-record: no metadata record: ~s" repository)))))))
270
   
271
 (defmethod repository-list-revision-ids ((repository lmdb-repository))
272
   (or (rlmdb:get-revision-uuids (repository-lmdb-repository repository))
273
       (let ((only-one-uuid (rlmdb:get-metadata-uuid repository)))
274
         (when only-one-uuid (list only-one-uuid)))))
275
 
276
 (defmethod initialize-repository-storage ((repository-id string) (prototype lmdb-repository) &key)
277
   "Given the root lmdb database, create a temporary reference repository and
278
   open it with :create. This causes it to create the sub-databases respective
279
   the index structure.
280
   Creating the sub-databases also stores the initial meta record, the class
281
   property and an eventual revision record.
282
 
283
   nb. Close it in order that it does not linger (see the opening notes, above)."
284
   (call-next-method)
285
   (let ((storage (compute-reference-lmdb-repository prototype :repository-id repository-id)))
286
     (assert (validate-storage-class prototype storage) ()
287
             "The repository and storage classes are not compatible: ~s ~s"
288
             (type-of prototype) (type-of storage))
289
     (lmdb:open-environment storage :if-does-not-exist :create :class (type-of prototype))
290
     (lmdb:close-environment storage))
291
   prototype)
292
 
293
 (defmethod initialize-repository-storage ((repository-id string) (prototype lmdb-temporal-repository) &key temporal-properties)
294
   (call-next-method)
295
   (assert (or (stringp temporal-properties)
296
               (and (consp temporal-properties) (every #'iri-p temporal-properties)))
297
           ()
298
           "initialize-repository-storage(lmdb-temporal-repository): temporal-properties is required.")
299
   (etypecase temporal-properties
300
     (string )
301
     (cons (setf temporal-properties
302
                 (format nil "~{~a~^ ~}" (loop for property in temporal-properties collect (iri-lexical-form property))))))
303
   (rlmdb:put-metadata repository-id
304
                       (list "temporal-properties" temporal-properties)))
305
 
306
 (defmethod initialize-repository-storage ((repository-id string) (prototype lmdb-time-series-repository) &key time-series-properties)
307
   (call-next-method)
308
   (assert (or (stringp time-series-properties)
309
               (and (consp time-series-properties) (every #'iri-p time-series-properties))) ()
310
           "initialize-repository-storage(lmdb-time-series-repository): time-series-properties is required.")
311
   (etypecase time-series-properties
312
     (string )
313
     (cons (setf time-series-properties
314
                 (format nil "~{~a~^ ~}" (loop for property in time-series-properties collect (iri-lexical-form property))))))
315
   (rlmdb:put-metadata repository-id
316
                       (list "time-series-properties" time-series-properties)))
317
 
318
 
319
 (defmethod repository-revision-bounds ((repository lmdb-repository))
320
   (when (repository-is-revisioned repository)
321
     (let ((start (rlmdb:find-revision-timestamp repository :tail))
322
           (end (rlmdb:find-revision-timestamp repository :head)))
323
       (spocq:make-date-time-interval :start (timeline-location-date-time start)
324
                                      :end  (timeline-location-date-time end)))))
325
 
326
 (defmethod compute-repository-revision ((reference lmdb-repository) (revision-designator integer) &rest args)
327
   (declare (dynamic-extent args))
328
   (apply #'compute-repository-revision reference (rlmdb:find-revision-uuid reference revision-designator)
329
          args))
330
 
331
 (defmethod compute-repository-revision ((reference lmdb-repository) (revision-designator string)
332
                                         &key  (if-does-not-exist :error)
333
                                         (class (repository-revision-class reference))
334
                                         (revision-class class))
335
   "The lmdb-repository version deconstructs the revision designator, resolves
336
  bounds to concrete min/max ordinals and records, resolves and window/repeat
337
  intervals to ordinals or temporals and locates or instantiates the located instance.
338
  based on the properties, assert the proper modes"
339
   (multiple-value-bind (min-designator min-offset max-designator max-offset window-interval repeat-interval repeat-count)
340
                        (rlmdb:parse-compound-revision-designator revision-designator)
341
     ;; require that the designator was parsed
342
     (unless min-designator
343
       (error 'spocq.e:revision-invalid-error :datum revision-designator))
344
     ;; given the explicit revision specification
345
     ;; - if repetition is specified, convert a date-time interval to a duration
346
     ;; - if no repetition is specified, convert a duration interval to an end time
347
     (let* ((lmdb-repository (repository-lmdb-repository reference))
348
            (min-record (rlmdb:find-revision-record lmdb-repository min-designator
349
                                                    :if-does-not-exist if-does-not-exist
350
                                                    :offset min-offset))
351
            (max-record nil)
352
            (modes ()))
353
       ;; resolve to either min+max or min+internval+repeat
354
       (cond ((null min-record)
355
              ;; the repository is _completely_ empty? 
356
              (spocq.e:revision-not-found-error :identifier revision-designator))
357
             ((and repeat-interval max-designator window-interval repeat-count)
358
              ;; repeat-count and maximum and window is over-constrained
359
              (spocq.e:revision-invalid-error :identifier revision-designator))
360
             ((and repeat-interval max-designator window-interval)
361
              ;; this is a repeated window to a limit
362
              (push :retrospective modes)
363
              (push :interval modes)
364
              (setf max-record (rlmdb:find-revision-record lmdb-repository max-designator
365
                                                           :offset max-offset)))
366
             ((and repeat-interval window-interval repeat-count)
367
              ;; this is a repeated window to a count
368
              (cond ((equalp min-designator "HEAD") (push :prospective modes))
369
                    (t (push :retrospective modes)))
370
              (push :interval modes))
371
             ((and repeat-interval max-designator repeat-count)
372
              ;; this is a repeated window to a count, but the window interval is
373
              ;; expressed as an initial upper bound
374
              ;; convert date-time, timestamp into a duration
375
              ;; convert uuid, ordinal, name into an offset
376
              (push :interval modes)
377
              (cond ((equalp min-designator "HEAD") (push :prospective modes))
378
                    (t (push :retrospective modes)))
379
              (push :interval modes)
380
              (etypecase max-designator
381
                (spocq:temporal-location
382
                 (when max-offset
383
                   (setf max-designator
384
                         (timeline-location-date-time (rlmdb:revision-record-timestamp
385
                                                       (rlmdb:find-revision-record lmdb-repository max-designator
386
                                                                                   :offset max-offset)))))
387
                 (setf window-interval (spocq.e:- max-designator (timeline-location-date-time (rlmdb:revision-record-timestamp min-record)))))
388
                ((or string (and symbol (not null)))
389
                 (setf window-interval (- (rlmdb:revision-record-ordinal (rlmdb:find-revision-record lmdb-repository max-designator
390
                                                                                                     :offset max-offset))
391
                                          (rlmdb:revision-record-ordinal min-record))))
392
                (integer
393
                 (setf window-interval (- max-designator (rlmdb:revision-record-ordinal min-record)))))
394
              (setf max-designator nil))
395
             ((and repeat-interval repeat-count)
396
              (cond ((equalp min-designator "HEAD") (push :prospective modes))
397
                    (t (push :retrospective modes)))
398
              (push :interval modes)
399
              ;; convert a date-time into a duration. leave a duration or offset as is
400
              (etypecase repeat-interval
401
                (spocq:temporal-location
402
                 (setf repeat-interval
403
                       (spocq.e:- repeat-interval
404
                                  (timeline-location-date-time (rlmdb:revision-record-timestamp min-record)))))
405
                ((or integer spocq:duration) )))
406
             (repeat-interval
407
              (cond ((equalp min-designator "HEAD") (push :prospective modes))
408
                    (t (push :retrospective modes)))
409
              (push :interval modes)
410
              ;; 20200302: no record of the motivating case
411
              ;; removed, as this precludes a form such as HEAD/1/1, which wuld be indefinitie monitoring
412
              ;; given just an interval transform it into the max desinator
413
              #+(or)
414
              (etypecase repeat-interval
415
                ((or spocq:temporal-location integer)
416
                 (setf max-record (rlmdb:find-revision-record lmdb-repository repeat-interval)))
417
                (spocq:duration
418
                 (setf max-record (rlmdb:find-revision-record lmdb-repository min-record :offset repeat-interval)))))
419
             (max-designator
420
              ;; just the end revision
421
              (push :interval modes)
422
              (setf max-record (rlmdb:find-revision-record lmdb-repository max-designator
423
                                                           :offset max-offset)))
424
             (t
425
              (cond ((equalp min-designator "HEAD"))
426
                    (t (push :retrospective modes)))
427
              (push :instant modes)))
428
       ;; augment with alternative designators and instantiate the revision
429
       (let* ((min-uuid (rlmdb:revision-record-uuid min-record))
430
              (min-ordinal (rlmdb:revision-record-ordinal min-record))
431
              (max-uuid (when max-record (rlmdb:revision-record-uuid max-record)))
432
              (max-ordinal (when max-record (rlmdb:revision-record-ordinal max-record)))
433
              (interval-key (etypecase window-interval
434
                              (null nil)
435
                              (integer window-interval)
436
                              (spocq:temporal (spocq:literal-lexical-form window-interval))))
437
              (repeat-key (etypecase repeat-interval
438
                            (null nil)
439
                            (integer repeat-interval)
440
                            (spocq:duration (spocq:literal-lexical-form repeat-interval))))
441
              (revision-key (list min-uuid max-uuid interval-key repeat-key repeat-count))
442
              (existing-instance (get-registry revision-key *repositories*))
443
              (revision (if (and existing-instance (typep existing-instance revision-class)) ;; allow class change to invalidate old instance
444
                            existing-instance
445
                            (setf (get-registry revision-key *repositories*)
446
                                  (make-instance revision-class
447
                                    :reference-revision-id (if (string-equal revision-designator "HEAD")
448
                                                               min-uuid
449
                                                               (rlmdb:find-revision-uuid reference :head))
450
                                    :revision-id min-uuid :reference reference
451
                                    :min-revision-record min-record :max-revision-record max-record
452
                                    :min-revision-ordinal min-ordinal :max-revision-ordinal max-ordinal
453
                                    :window-interval window-interval
454
                                    :repeat-interval repeat-interval
455
                                    :repeat-limit repeat-count
456
                                    :designator revision-designator
457
                                    :mode modes)))))
458
         (assert (equal (repository-id reference) (repository-id (repository-revision-reference revision))) ()
459
                 "compute-repository-revision: clone does not match reference : for designator->id ~s->~s : ~s != ~s"
460
                 revision-designator min-uuid
461
                 (repository-id reference) (repository-id (repository-revision-reference revision)))
462
         revision))))
463
 
464
 
465
 (defgeneric map-repository-revision-intervals (operator revision)
466
   (:documentation "Given a revision interpret combinations of min/max bounds, windows and counts
467
    to iterate over the sequence of designated revisions and invoke the given operator with the
468
    respective min/max revision records.
469
    The revision modes are used to distinguish the three principal cases:
470
    - instant: a single revision can be with a static window
471
    - retrospective: slide the window min/max over the global min/max
472
    - prospective: re-establish the bounds for every new revision module the repeat interval")
473
   (:method (operator (revision repository-revision))
474
     "Given a static revision, the bounds never change."
475
     (funcall operator
476
              (revision-min-revision-record revision)
477
              (revision-max-revision-record revision)))
478
 
479
   (:method (operator (revision lmdb-revision)) 
480
     (let ((min-record (revision-min-revision-record revision))
481
           (max-record (revision-max-revision-record revision))
482
           (window-interval (revision-window-interval revision))
483
           (repeat-interval (revision-repeat-interval revision))
484
           (repeat-limit (revision-repeat-limit revision))
485
           (result nil))
486
       ;; (print (list :to-map min-record max-record window-interval repeat-interval repeat-limit))
487
       (cond ((is-instant-revision revision)
488
              (setf result (funcall operator min-record (or min-record max-record))))
489
             ((is-retrospective-revision revision)
490
              (if repeat-limit
491
                  ;; iterate for indicate window count
492
                  (loop for step from 0 below repeat-limit
493
                    with w-min-record = min-record
494
                    with w-max-record = (compute-first-revision-bounds (repository-lmdb-repository revision)
495
                                                                     min-record window-interval)
496
                    while (and w-max-record
497
                               (or (null max-record)
498
                                   (< (rlmdb:revision-record-timestamp w-max-record) (rlmdb:revision-record-timestamp max-record)))) 
499
                    do (progn (setf result (funcall operator w-min-record (or w-min-record w-max-record)))
500
                         (multiple-value-setq (w-min-record w-max-record)
501
                           (compute-next-revision-bounds (repository-lmdb-repository revision)
502
                                                         w-min-record window-interval repeat-interval))))
503
                  (loop
504
                    with w-min-record = min-record
505
                    with w-max-record = (compute-first-revision-bounds (repository-lmdb-repository revision)
506
                                                                     min-record window-interval)
507
                    while (and w-max-record
508
                               (or (null max-record)
509
                                   (< (rlmdb:revision-record-timestamp w-max-record) (rlmdb:revision-record-timestamp max-record))))
510
                    do (progn (setf result (funcall operator min-record (or w-min-record w-max-record)))
511
                         (multiple-value-setq (w-min-record w-max-record)
512
                           (compute-next-revision-bounds (repository-lmdb-repository revision)
513
                                                         w-min-record window-interval repeat-interval))))))
514
             ((is-prospective-revision revision)
515
              ;; drive the iteration from commit notifications
516
              ;; just the repeat interval and count govern the iteration
517
              ;; the window-interval would matter only it is to be allowed that the min-revision is offset
518
              ;; into the past from HEAD
519
              (with-repository-commit-notifications (new-revision revision :interval repeat-interval :limit repeat-limit)
520
                ;; recompute the revision properties based on the original designator
521
                (let* ((min-record (revision-min-revision-record revision))
522
                       (max-record (revision-max-revision-record revision)))
523
                  (setf result (funcall operator min-record (or min-record max-record)))))))
524
       result)))
525
 
526
 
527
 (defgeneric compute-first-revision-bounds (repository min-record window-interval)
528
   (:method ((repository rlmdb:repository) (min-record rlmdb:revision-record) (window-interval integer))
529
     "For two ordinal repetition parameters, return the revision records for the
530
      offset ordinal bounds."
531
     (let* ((min-ordinal (rlmdb:revision-record-ordinal min-record))
532
            (max-ordinal (+ min-ordinal window-interval))
533
            (max-record (rlmdb:get-revision-record repository max-ordinal)))
534
       (values min-record max-record)))
535
   (:method ((repository rlmdb:repository) (min-record rlmdb:revision-record) (window-interval spocq:duration))
536
     "For a duration window and an ordinal step, offset the min and locate the max."
537
     (let* ((max-date-time (spocq.e:+ (rlmdb:revision-record-date-time min-record) window-interval))
538
            (max-record (rlmdb:find-revision-record repository max-date-time)))
539
       (values min-record max-record))))
540
 
541
 
542
 (defgeneric compute-next-revision-bounds (repository min-record window-interval repeat-interval)
543
   (:method ((repository rlmdb:repository) (min-record rlmdb:revision-record) (window-interval integer) (repeat-interval integer))
544
     "For two ordinal repetition parameters, return the revision records for the
545
      offset ordinal bounds."
546
     (let* ((min-ordinal (+ (rlmdb:revision-record-ordinal min-record) repeat-interval))
547
            (min-record (rlmdb:get-revision-record repository min-ordinal))
548
            (max-ordinal (+ min-ordinal window-interval))
549
            (max-record (rlmdb:get-revision-record repository max-ordinal)))
550
       (values min-record max-record)))
551
   (:method ((repository rlmdb:repository) (min-record rlmdb:revision-record) (window-interval integer) (repeat-interval spocq:duration))
552
     "For an ordinal window and duration step, locate the min and offset the max."
553
     (let* ((min-date-time (spocq.e:+ (rlmdb:revision-record-date-time min-record) repeat-interval))
554
            (min-record (rlmdb:find-revision-record repository min-date-time))
555
            (max-ordinal (rlmdb:revision-record-ordinal min-record))
556
            (max-record (rlmdb:get-revision-record repository max-ordinal)))
557
       (values min-record max-record)))
558
   (:method ((repository rlmdb:repository) (min-record rlmdb:revision-record) (window-interval spocq:duration) (repeat-interval integer))
559
     "For a duration window and an ordinal step, offset the min and locate the max."
560
     (let* ((min-ordinal (+ (rlmdb:revision-record-ordinal min-record) repeat-interval))
561
            (min-record (rlmdb:get-revision-record repository min-ordinal))
562
            (max-date-time (spocq.e:+ (rlmdb:revision-record-date-time min-record) window-interval))
563
            (max-record (rlmdb:find-revision-record repository max-date-time)))
564
       (values min-record max-record)))
565
   (:method ((repository rlmdb:repository) (min-record rlmdb:revision-record) (window-interval spocq:duration) (repeat-interval spocq:duration))
566
     "For two duration repstition parameters, locate the min record and then,
567
      from there the max"
568
     (let* ((min-date-time (spocq.e:+ (rlmdb:revision-record-date-time min-record) repeat-interval))
569
            (min-record (rlmdb:find-revision-record repository min-date-time))
570
            (max-date-time (spocq.e:+ (rlmdb:revision-record-date-time min-record) window-interval))
571
            (max-record (rlmdb:find-revision-record repository max-date-time)))
572
       (values min-record max-record))))
573
 
574
 (defgeneric compute-previous-revision-bounds (repository min-record window-interval repeat-interval)
575
   (:method ((repository rlmdb:repository) (min-record rlmdb:revision-record) (window-interval integer) (repeat-interval integer))
576
     "For two ordinal repetition parameters, return the revision records for the
577
      offset ordinal bounds."
578
     (let* ((min-ordinal (- (rlmdb:revision-record-ordinal min-record) repeat-interval))
579
            (min-record (rlmdb:get-revision-record repository min-ordinal))
580
            (max-ordinal (+ min-ordinal window-interval))
581
            (max-record (rlmdb:get-revision-record repository max-ordinal)))
582
       (values min-record max-record)))
583
   (:method ((repository rlmdb:repository) (min-record rlmdb:revision-record) (window-interval integer) (repeat-interval spocq:duration))
584
     "For an ordinal window and duration step, locate the min and offset the max."
585
     (let* ((min-date-time (spocq.e:- (rlmdb:revision-record-date-time min-record) repeat-interval))
586
            (min-record (rlmdb:find-revision-record repository min-date-time))
587
            (max-ordinal (rlmdb:revision-record-ordinal min-record))
588
            (max-record (rlmdb:get-revision-record repository max-ordinal)))
589
       (values min-record max-record)))
590
   (:method ((repository rlmdb:repository) (min-record rlmdb:revision-record) (window-interval spocq:duration) (repeat-interval integer))
591
     "For a duration window and an ordinal step, offset the min and locate the max."
592
     (let* ((min-ordinal (- (rlmdb:revision-record-ordinal min-record) repeat-interval))
593
            (min-record (rlmdb:get-revision-record repository min-ordinal))
594
            (max-date-time (spocq.e:+ (rlmdb:revision-record-date-time min-record) window-interval))
595
            (max-record (rlmdb:find-revision-record repository max-date-time)))
596
       (values min-record max-record)))
597
   (:method ((repository rlmdb:repository) (min-record rlmdb:revision-record) (window-interval spocq:duration) (repeat-interval spocq:duration))
598
     "For two duration repstition parameters, locate the min record and then,
599
      from there the max"
600
     (let* ((min-date-time (spocq.e:- (rlmdb:revision-record-date-time min-record) repeat-interval))
601
            (min-record (rlmdb:find-revision-record repository min-date-time))
602
            (max-date-time (spocq.e:+ (rlmdb:revision-record-date-time min-record) window-interval))
603
            (max-record (rlmdb:find-revision-record repository max-date-time)))
604
       (values (values min-record max-record)))))
605
 
606
                                               
607
 (defmethod call-with-open-transaction ((operator function) (transaction lmdb-transaction) &rest args)
608
   "Provide a thread-specific lmdb transaction.
609
  This is cloned from the respective repository's initial transaction and active
610
  with dynamic extent only. As the lmdb data path is read-only, the disposition
611
  as always to abort."
612
   (declare (ignore args))
613
   (let* ((revision (transaction-revision transaction))
614
          (rlmdb:repository (repository-lmdb-repository revision)))
615
     (declare (ignorable rlmdb:repository))
616
     #+lmdb-write-transactions
617
     ;; if the transaction is read-only, reuse the global transaction
618
     (cond ((transaction-read-only-p transaction)
619
            #+(or)
620
            (let ((lmdb:transaction (transaction-lmdb-transaction transaction)))
621
              (lmdb:with-transaction (lmdb:transaction :normal-disposition :continue :error-disposition :continue)
622
                (call-next-method)))
623
            (call-next-method))
624
           ;; otherwise establish a new - thread-specific transaction over the repository environment
625
           (t
626
            (let ((lmdb:transaction (lmdb:make-transaction rlmdb:repository :flags 0)))
627
              (lmdb:with-transaction (lmdb:transaction :normal-disposition :commit)
628
                (call-next-method)))))
629
     #-lmdb-write-transactions
630
     (call-next-method)
631
     ))
632
   
633
 
634
 (defgeneric transaction-lmdb-repository (transaction)
635
   (:method ((transaction lmdb-transaction))
636
     (let* ((revision (transaction-revision transaction))
637
            (rlmdb:repository (repository-lmdb-repository revision)))
638
       rlmdb:repository)))
639
 
640
 
641
 (defmethod transaction-open ((transaction lmdb-transaction) &rest args)
642
   (declare (ignore args) (dynamic-extent args))
643
   (call-next-method))
644
 
645
 (defmethod transaction-close ((transaction lmdb-transaction) (disposition (eql :continue)))
646
   (call-next-method))
647
 
648
 (defmethod transaction-close ((transaction lmdb-transaction) (disposition (eql :abort)))
649
   (call-next-method)
650
   (let ((lmdb:transaction (bound-slot-value transaction 'lmdb-transaction)))
651
     (when (lmdb:open-p lmdb:transaction)
652
       (lmdb:abort-transaction lmdb:transaction))
653
     (setf-transaction-lmdb-transaction nil transaction)))
654
 
655
 (defmethod transaction-close ((transaction lmdb-transaction) (disposition (eql :commit)))
656
   (call-next-method)
657
   (let ((lmdb:transaction (bound-slot-value transaction 'lmdb-transaction)))
658
     (when (lmdb:open-p lmdb:transaction)
659
       (lmdb:commit-transaction lmdb:transaction))
660
     (setf-transaction-lmdb-transaction nil transaction)))
661
 
662
 (defmethod call-for-task-revisions (operator (task task) (revision lmdb-revision))
663
   "iterate over revisions..."
664
   (declare (dynamic-extent operator))
665
   (flet ((call-for-next-bounds (min-record max-record)
666
            (setf (revision-min-revision-record revision) min-record
667
                  (revision-max-revision-record revision) max-record
668
                  (revision-min-revision-ordinal revision) (rlmdb:revision-record-ordinal min-record)
669
                  (revision-max-revision-ordinal revision) (rlmdb:revision-record-ordinal max-record))
670
            (funcall operator task revision)))
671
     (declare (dynamic-extent #'call-for-next-bounds))
672
     (map-repository-revision-intervals #'call-for-next-bounds revision)))
673
 
674
 (defun get-lmdb-session-data (session-id)
675
   (let* ((location #p"/srv/dydra/runtime/sessions/")
676
          (env (lmdb:make-environment location)))
677
     (lmdb:with-environment (env)
678
       (lmdb:with-transaction ((txn (lmdb:make-transaction env)))
679
         (let ((db (lmdb:make-database "id:data")))
680
           (lmdb:ensure-open-database db)
681
           (let ((data-string (map 'string #'code-char (lmdb:get db session-id))))
682
             (when (plusp (length data-string)) (parse-json data-string))))))))
683
 ;;; 20171108 on atomgraph: (get-lmdb-session-data "f5515bd328215305b7a44cbd9eb09aca")
684
 
685
 (defgeneric query-account-by-number (repository id)
686
   (:method ((repository-id string) (account-id t))
687
     (query-account-by-number (repository repository-id) account-id))
688
   (:method ((repository repository) (account-id integer))
689
     (query-account-by-number repository (prin1-to-string account-id)))
690
   (:method ((repository repository) (account-id string))
691
     (run-sparql
692
      `(spocq.a:|select|
693
                (spocq.a:|leftjoin|
694
                         (spocq.a:|join|
695
                                  (spocq.a:|graph| ?::account
696
                                           (spocq.a:|bgp|
697
                                                    (spocq.a:|triple| ?::account |sioc|:|id| ,account-id)
698
                                                    (spocq.a:|triple| ?::account |sioc|:|has_owner| ?::user)))
699
                                  (spocq.a:|graph| |urn:dydra|:|users|
700
                                           (spocq.a:|bgp|
701
                                                    (spocq.a:|triple| ?::user |dc|:|title| ?::name))))     
702
                         (spocq.a:|graph| |urn:dydra|:|users|
703
                                  (spocq.a:|bgp|
704
                                           (spocq.a:|triple| ?::user |sioc|:|administrator_of|  ?::isAdminOf))))
705
                (?::user ?::isAdminOf ?::name))
706
      :repository repository
707
      :agent (system-agent))))
708
 
709
 (defmethod authenticate-user-session ((repository lmdb-repository) (session-id string))
710
   ;; ginve an lmdb-based implementation, retrieve he information from the dydra sesions dataabse
711
   (let ((warden-data (rest (assoc "warden.user.account.key" (get-lmdb-session-data session-id) :test #'equalp))))
712
     (when warden-data
713
       (let* ((account-id (elt (elt warden-data 1) 0))
714
              (results (query-account-by-number repository account-id)))
715
         (when (consp results)
716
           (when (rest results)
717
             ;; error. it could yield an uintended user
718
             (error "authenticate-user-session: anomalous results for session ~s: ~s" session-id results))
719
           (destructuring-bind (user-id is-admin user-name) (first results)
720
             (unless (stringp user-name)
721
               (log-warn "anomalous user session authentication results: ~s"
722
                         (list user-id is-admin user-name session-id))
723
               (let* ((iri-string (iri-lexical-form user-id))
724
                      (iri-name (first (last (split-string iri-string "/")))))
725
                 (setf user-name iri-name)))
726
             (values user-id (not (spocq:unbound-variable-p is-admin)) user-name)))))))
727
                           
728
 ;;; => "{\"http_referrer\":\"none\",\"_csrf_token\":\"A/QYimj0YZHUDNXO6794feXVyxDd9FkY4QeBq+9syx8=\",\"warden.user.account.key\":[\"Account\",[4],\"$2a$10$m/PkvH/vyr8/o5H.4sS8je\"]}"
729
 ;;; (parse-json "{\"http_referrer\":\"none\",\"_csrf_token\":\"A/QYimj0YZHUDNXO6794feXVyxDd9FkY4QeBq+9syx8=\",\"warden.user.account.key\":[\"Account\",[4],\"$2a$10$m/PkvH/vyr8/o5H.4sS8je\"]}")
730
 ;;; => (("http_referrer" . "none") ("_csrf_token" . "A/QYimj0YZHUDNXO6794feXVyxDd9FkY4QeBq+9syx8=") ("warden.user.account.key"  . #("Account" #(4) "$2a$10$m/PkvH/vyr8/o5H.4sS8je")))
731
 ;;; (authenticate-user-session (system-repository) "c71e1eb0c3c96e408d7f423ec6b7abff")
732
 ;;; (test-sparql "delete { <http://dydra.com/accounts/christophe-dupriez> ?p ?o
733
 
734
 ;;; repository signatures
735
 
736
 (defmethod compute-revision-signature ((repository-id string) &rest args)
737
   (declare (dynamic-extent args))
738
   (apply #'compute-revision-signature (repository repository-id) args))
739
 
740
 (defmethod compute-revision-signature ((repository lmdb-repository) &rest args)
741
   (declare (dynamic-extent args))
742
   (apply #'rlmdb.i::compute-rlmdb-revision-signature (repository-lmdb-repository repository) args))
743
 
744
 (defmethod compute-revision-signature ((revision lmdb-revision) &rest args &key
745
                                        digest-type
746
                                        (first (revision-min-revision-ordinal revision))
747
                                        (last (revision-max-revision-ordinal revision)))
748
   (declare (dynamic-extent args) (ignore digest-type))
749
   (apply #'rlmdb.i::compute-rlmdb-revision-signature (repository-lmdb-repository revision)
750
          :revision-predicate (compute-revision-predicate (list :first first :last last))
751
          args))
752
 
753
 
754
 ;;; term resolution
755
 
756
 #+(or) ;; direct lexical form retrieval
757
 (defmethod repository-term-deconstructor ((transaction lmdb-transaction))
758
   "Where a direct interface to the lmdb store is available, the deconstructor
759
  retrieves the term aspects directly within its own transaction.
760
  
761
  there should really be an alterative which is given a stream, to write the results directly,
762
  without first retrieving them "
763
   (call-next-method)
764
   )
765
 
766
 (defgeneric term-encoder (transaction encoding)
767
   (:documentation "returns an operator of two parameters, a term number and a
768
    stream. The operator accepts the two arguments and encodes the term as per
769
    the encoding media type to the stream. The encoding may be the complete
770
    lexical form of an n-quads term or just the uri attribute value for an xml
771
    encoding, as is required by the encoding."))
772
 
773
 ;;; support for single-transaction describes
774
 
775
 (defmethod process-describe ((subject-source lmdb-transaction) (object-source lmdb-transaction)
776
                              (destination array-page-channel)
777
                              (base-source array-page-channel)
778
                              base-dimensions subjects)
779
   (let* ((revision (transaction-revision subject-source))
780
          (rlmdb:repository (repository-lmdb-repository revision))
781
          (lmdb:transaction (lmdb:make-transaction rlmdb:repository))
782
          (all-term-number (object-term-number '|urn:dydra|:|all|))
783
          (type-term-number (object-term-number '|rdf|:|type|)) ;; anything constant
784
          (subject-quad-pattern (vector all-term-number type-term-number 0 0))
785
          (object-quad-pattern (vector all-term-number 0 0 type-term-number)))
786
     (lmdb:with-transaction (lmdb:transaction :initial-disposition :begin
787
                                              :normal-disposition :abort
788
                                              :error-disposition :abort)
789
       (let ((subject-index-database (rlmdb.i::repository-quad-pattern-index rlmdb:repository subject-quad-pattern))
790
             (object-index-database (rlmdb.i::repository-quad-pattern-index rlmdb:repository object-quad-pattern)))
791
         (spocq.i::process-describe subject-index-database object-index-database
792
                                    destination base-source
793
                                    base-dimensions subjects)))))
794
 
795
 #|
796
 the arrangment saves about five microseconds per describe traversal step by using just one transaction
797
 an example from atomgraph with 11K steps was (neglecting profile) about .9 seconds faster with the single transaction.
798
 
799
 ;; multiple transactions:
800
 
801
 * (time
802
 (length
803
  (test-sparql (read-file #P"/mnt/hdd/dydra/history/queries/linkeddatahub/08/08eee7bdc9ceff95ad31ead1defb43ab6360f1b7")
804
               :repository-id "linkeddatahub/docs-admin-dev")))
805
 
806
 Evaluation took:
807
   0.440 seconds of real time
808
   0.500000 seconds of total run time (0.412000 user, 0.088000 system)
809
   113.64% CPU
810
   367 lambdas converted
811
   1,537,379,817 processor cycles
812
   53,044,048 bytes consed
813
   
814
 56
815
 * (sb-profile:report)
816
 
817
   seconds  |     gc     |   consed   |  calls |  sec/call  |  name  
818
 ---------------------------------------------------------
819
      0.210 |      0.000 | 24,499,552 | 21,156 |   0.000010 | ORG.DATAGRAPH.RDF.LMDB:MAP-REPOSITORY-STATEMENTS
820
      0.041 |      0.000 |  2,824,880 | 10,585 |   0.000004 | LMDB:MAKE-TRANSACTION
821
      0.009 |      0.000 |    917,280 | 10,585 |   0.000001 | LMDB:BEGIN-TRANSACTION
822
      0.000 |      0.000 |    688,352 | 10,585 |   0.000000 | LMDB:ABORT-TRANSACTION
823
 ---------------------------------------------------------
824
      0.259 |      0.000 | 28,930,064 | 52,911 |            | Total
825
 
826
 estimated total profiling overhead: 0.04 seconds
827
 overhead estimation parameters:
828
   1.6000001e-8s/call, 7.76e-7s total profiling, 3.04e-7s internal profiling
829
 * 
830
 
831
 
832
 ;;; single transaction
833
 * (time
834
 (length
835
  (test-sparql (read-file #P"/mnt/hdd/dydra/history/queries/linkeddatahub/08/08eee7bdc9ceff95ad31ead1defb43ab6360f1b7")
836
               :repository-id "linkeddatahub/docs-admin-dev")))
837
 
838
 Evaluation took:
839
   0.349 seconds of real time
840
   0.404000 seconds of total run time (0.316000 user, 0.088000 system)
841
   115.76% CPU
842
   367 lambdas converted
843
   1,218,773,796 processor cycles
844
   49,704,336 bytes consed
845
   
846
 Resuming thread #<THREAD "main thread" RUNNING {1005D3E413}>
847
 56
848
 * (sb-profile:report)
849
 
850
   seconds  |     gc     |   consed   |  calls |  sec/call  |  name  
851
 ---------------------------------------------------------
852
      0.169 |      0.000 | 25,321,248 | 10,594 |   0.000016 | ORG.DATAGRAPH.RDF.LMDB:MAP-REPOSITORY-STATEMENTS
853
      0.004 |      0.000 |     32,768 |     24 |   0.000166 | LMDB:MAKE-TRANSACTION
854
      0.000 |      0.000 |          0 |     24 |   0.000000 | LMDB:BEGIN-TRANSACTION
855
      0.000 |      0.000 |     32,768 |     24 |   0.000000 | LMDB:ABORT-TRANSACTION
856
 ---------------------------------------------------------
857
      0.173 |      0.000 | 25,386,784 | 10,666 |            | Total
858
 
859
 estimated total profiling overhead: 0.01 seconds
860
 overhead estimation parameters:
861
   8.000001e-9s/call, 8.16e-7s total profiling, 2.88e-7s internal profiling
862
 * 
863
 
864
 
865
 |#
866
 
867
 
868
 ;;; kleen star path support
869
 
870
 (defmethod map-repository-subject-and-objects ((continuation function) (transaction lmdb-transaction) context &rest args)
871
   (declare (ignore args)) ;; distinct is ignored
872
   ;; the path processsing does it anyway to merge sujects and object
873
   ;; function (context termid)
874
   (flet ((lmdb-continuation (%quad)
875
            (funcall continuation (%quad-context %quad) (%quad-subject %quad))
876
            (funcall continuation (%quad-context %quad) (%quad-object %quad))))
877
     (declare (dynamic-extent #'lmdb-continuation))
878
     (let ((quad-pattern (vector context 0 0 0)))
879
       (rlmdb:map-repository-statements #'lmdb-continuation transaction
880
                                        quad-pattern
881
                                        :revision-predicate (compute-revision-predicate transaction)))))
882
 
883
 (defun read-rlmdb-pattern-count (lmdb-repository-designator stn ptn otn ctn &rest args)
884
   (let ((count 0))
885
     (flet ((count-quad (%quad) (declare (ignore %quad)) (incf count)))
886
       (declare (dynamic-extent #'count-quad))
887
       (apply #'rlmdb:map-repository-statements #'count-quad lmdb-repository-designator
888
              (vector ctn stn ptn otn)
889
              args))
890
     count))
891
 
892
 
893
 (defgeneric test-rlmdb-pattern-match (lmdb-repository-designator stn ptn otn ctn &rest args)
894
   (:method ((repository lmdb-repository) stn ptn otn ctn &rest args)
895
     (flet ((match-quad (%quad)
896
              (declare (ignore %quad))
897
              (return-from test-rlmdb-pattern-match t)))
898
       (declare (dynamic-extent #'match-quad))
899
       (apply #'rlmdb:map-repository-statements #'match-quad (repository-lmdb-repository repository)
900
              (vector ctn stn ptn otn)
901
              args)
902
       nil))
903
   (:method ((revision lmdb-revision) stn ptn otn ctn &rest args
904
             &key
905
             (first (revision-min-revision-ordinal revision))
906
             (last (revision-max-revision-ordinal revision))
907
             &allow-other-keys)
908
     (declare (dynamic-extent args))
909
     (apply #'test-rlmdb-pattern-match (repository-revision-reference revision) stn ptn otn ctn
910
            :revision-predicate (compute-revision-predicate (list :first first :last last))
911
            args)))
912
 
913
 (defmethod repository-context-term-number ((transaction lmdb-transaction) context)
914
   (repository-context-term-number (transaction-repository transaction) context))
915
 
916
 (defmethod repository-context-term-number ((transaction lmdb-repository) context)
917
   (case context
918
     ((nil) (if transaction
919
                (repository-default-context-term-number transaction)
920
                rlmdb:*default-context-number*))
921
     ((|urn:dydra|:|all| :all t) rlmdb:*all-context-number*)
922
     ((|urn:dydra|:|default| :default) rlmdb:*default-context-number*)
923
     ((|urn:dydra|:|named| :named) rlmdb:*named-context-number*)
924
     (t
925
      (if (variable-p context)
926
          (ecase (named-contexts-term)
927
            (|urn:dydra|:|all| rlmdb:*all-context-number*)
928
            (|urn:dydra|:|default| rlmdb:*default-context-number*)
929
            (|urn:dydra|:|named| rlmdb:*named-context-number*))
930
          (rlmdb:value-term-number context :if-does-not-exist nil)))))
931
 
932
 (defparameter *wild-blank-nodes-p* t)
933
 
934
 (defmethod repository-pattern-term-number ((transaction lmdb-transaction) term)
935
   ;; this can treat blank nodes as variables for the use in presence matching and counting
936
   (if (or (null term)
937
           (and (spocq:blank-node-p term) *wild-blank-nodes-p*)
938
           (variable-p term)
939
           (eq term t))
940
       rlmdb:*wildcard-term-number*
941
       (rlmdb:value-term-number term :if-does-not-exist nil)))
942
 
943
 (defmethod repository-pattern-term-number ((transaction lmdb-repository) term)
944
   ;; this can treat blank nodes as variables for the use in presence matching and counting
945
   (if (or (null term)
946
           (and (spocq:blank-node-p term) *wild-blank-nodes-p*)
947
           (variable-p term)
948
           (eq term t))
949
       rlmdb:*wildcard-term-number*
950
       (rlmdb:value-term-number term :if-does-not-exist nil)))
951
 
952
 (defgeneric repository-pattern-match-p (repository subject predicate object context)
953
   (:documentation
954
    "Resolve all terms from sybolic to ordinal values and test presence.")
955
   (:method ((repository repository) subject predicate object context)
956
     (if (extension-operator-p predicate)
957
       t
958
       (let* ((context (repository-context-term-number repository context))
959
              (subject (repository-pattern-term-number repository subject))
960
              (predicate (repository-pattern-term-number repository predicate))
961
              (object (repository-pattern-term-number repository object)))
962
         (when (and context subject predicate object)
963
           (repository-pattern-match-p repository subject predicate object context)))))
964
   (:method ((repository shard-repository) (subject integer) (predicate integer) (object integer) (context integer))
965
     (test-rlmdb-pattern-match repository subject predicate object context))
966
   (:method ((transaction lmdb-transaction) subject predicate object context)
967
     (repository-pattern-match-p (transaction-revision transaction) subject predicate object context)))
968
 
969
 (defmethod read-repository-pattern-count ((repository shard-repository) subject predicate object context)
970
   "Resolve all terms from symbolic to ordinal values and perform the count."
971
   (if (extension-operator-p predicate)
972
       1
973
       (let* ((context (repository-context-term-number repository context))
974
              (subject (repository-pattern-term-number repository subject))
975
              (predicate (repository-pattern-term-number repository predicate))
976
              (object (repository-pattern-term-number repository object)))
977
         (if (and context subject predicate object)
978
             (if (and (zerop subject) (zerop predicate) (zerop object) (zerop context))
979
                 ;;!! all-wild for repository ignores the revision
980
                 ;; can delegate to a method which reads the count directly from the repo statistics record
981
                 (read-repository-statement-count repository)
982
                 (read-rlmdb-pattern-count repository subject predicate object context))
983
             0))))
984
 
985
 (defmethod read-repository-pattern-count ((transaction shard-transaction) subject predicate object context)
986
   "Resolve all terms from symbolic to ordinal values and perform the count.
987
   Given a transaction, the context term may resolve specific to the invocation."
988
   (if (extension-operator-p predicate)
989
       1
990
       (let* ((context (repository-context-term-number transaction context))
991
              (subject (repository-pattern-term-number transaction subject))
992
              (predicate (repository-pattern-term-number transaction predicate))
993
              (object (repository-pattern-term-number transaction object)))
994
         (if (and context subject predicate object)
995
             (if (and (zerop subject) (zerop predicate) (zerop object) (zerop context))
996
                 ;; can delegate to a method which reads the count directly from the repo statistics record
997
                 (read-repository-statement-count transaction)
998
                 (read-rlmdb-pattern-count transaction subject predicate object context
999
                                           :revision-predicate (compute-revision-predicate (list :first (transaction-min-revision-ordinal transaction)
1000
                                                                                                 :last (transaction-max-revision-ordinal transaction)))))
1001
             0))))
1002
 
1003
 (defmethod repository-pattern-count ((repository shard-repository) subject (predicate active-verb) object context)
1004
   1)
1005
 
1006
 (defmethod repository-pattern-count ((repository shard-repository) subject predicate object context)
1007
   "Resolve all terms from symbolic to ordinal values and perform the count."
1008
   (if (extension-operator-p predicate)
1009
       1
1010
       (let* ((context (repository-context-term-number repository context))
1011
              (subject (repository-pattern-term-number repository subject))
1012
              (predicate (repository-pattern-term-number repository predicate))
1013
              (object (repository-pattern-term-number repository object)))
1014
         (if (and context subject predicate object)
1015
             (if (and (zerop subject) (zerop predicate) (zerop object) (zerop context))
1016
                 ;;!! all-wild for repository ignores the revision
1017
                 ;; can delegate to a method which reads the count directly from the repo statistics record
1018
                 (read-repository-statement-count repository)
1019
                 (repository-pattern-count repository subject predicate object context))
1020
             0))))
1021
 
1022
 
1023
 (defmethod repository-pattern-count ((repository shard-repository)
1024
                                      (subject integer) (predicate integer) (object integer) (context integer))
1025
   (flet ((count-pattern ()
1026
            (read-rlmdb-pattern-count repository subject predicate object context)))
1027
     (let ((stats (repository-statistics repository))
1028
           (pattern (list subject predicate object context)))
1029
       (declare (dynamic-extent pattern))
1030
       (if (operation-read-only-p *task*)
1031
           (or (gethash pattern stats)
1032
               (setf (get-registry (copy-list pattern) stats) (count-pattern)))
1033
           (count-pattern)))))
1034
 
1035
 
1036
 (defmethod repository-pattern-count ((transaction shard-transaction) subject predicate object context)
1037
   "Resolve all terms from symbolic to ordinal values and perform the count.
1038
   Given a transaction, the context term may resolve specific to the invocation."
1039
   (if (extension-operator-p predicate)
1040
       1
1041
       (let* ((context (repository-context-term-number transaction context))
1042
              (subject (repository-pattern-term-number transaction subject))
1043
              (predicate (repository-pattern-term-number transaction predicate))
1044
              (object (repository-pattern-term-number transaction object)))
1045
         (if (and context subject predicate object)
1046
             (if (and (zerop subject) (zerop predicate) (zerop object) (zerop context))
1047
                 ;; can delegate to a method which reads the count directly from the repo statistics record
1048
                 (read-repository-statement-count transaction)
1049
                 (repository-pattern-count transaction subject predicate object context))
1050
             0))))
1051
 
1052
 (defmethod repository-pattern-count ((transaction shard-transaction)
1053
                                      (subject integer) (predicate integer) (object integer) (context integer))
1054
   (flet ((count-pattern ()
1055
            (read-rlmdb-pattern-count transaction subject predicate object context
1056
                                      :revision-predicate (compute-revision-predicate (list :first (transaction-min-revision-ordinal transaction)
1057
                                                                                            :last (transaction-max-revision-ordinal transaction))))))
1058
     (let* ((revision (transaction-revision transaction))
1059
            (stats (repository-statistics revision))
1060
            (pattern (list subject predicate object context)))
1061
       (declare (dynamic-extent pattern))
1062
       (if (operation-read-only-p *task*)
1063
           (or (gethash pattern stats)
1064
               (setf (get-registry (copy-list pattern) stats) (count-pattern)))
1065
           (count-pattern)))))
1066
 
1067
 (defmethod repository-statement-count ((repository lmdb-repository))
1068
   (read-repository-statement-count repository))
1069
 
1070
 (defmethod read-repository-statement-count ((repository lmdb-repository))
1071
   "Given a repository, return the global eindex entry count"
1072
   (rlmdb::entry-count repository))
1073
 
1074
 (defmethod read-repository-statement-count ((revision lmdb-revision))
1075
   "Given a repository, return the global eindex entry count"
1076
   (read-rlmdb-pattern-count revision 0 0 0 0
1077
                             :revision-predicate (compute-revision-predicate (list :first (revision-min-revision-ordinal revision)
1078
                                                                                   :last (revision-max-revision-ordinal revision)))))
1079
 
1080
 (defmethod read-repository-statement-count ((transaction lmdb-transaction))
1081
   "Given a transaction, count statements specific to the respective version window"
1082
   (read-rlmdb-pattern-count transaction 0 0 0 0
1083
                             :revision-predicate (compute-revision-predicate (list :first (transaction-min-revision-ordinal transaction)
1084
                                                                                   :last (transaction-max-revision-ordinal transaction)))))
1085
 
1086
 (defmethod repository-statement-count ((transaction lmdb-transaction))
1087
   (read-repository-statement-count transaction))
1088
 
1089
 (defmethod repository-intern-property-path ((repository shard-repository) property-path)
1090
   (rlmdb:intern-property-path property-path))
1091
 
1092
 (defmethod repository-intern-property-path ((repository shard-transaction) property-path)
1093
   (rlmdb:intern-property-path property-path))
1094
 
1095
 
1096
 ;;; mapping
1097
 
1098
 (defmethod map-repository-contexts (function (transaction lmdb-transaction) &key
1099
                                              (distinct t)
1100
                                              (default t))
1101
   (rlmdb::map-context-numbers function (transaction-repository transaction)
1102
                               :distinct distinct :default default
1103
                               :revision-predicate (compute-revision-predicate transaction)))
1104
 
1105
 (defmethod map-repository-contexts (function (repository lmdb-repository) &key
1106
                                              (distinct t)
1107
                                              (default t))
1108
   (rlmdb::map-context-numbers function repository
1109
                               :distinct distinct :default default
1110
                               :revision-predicate (compute-revision-predicate repository)))
1111
 
1112
 
1113
 (defmethod map-repository-subjects (function (transaction lmdb-transaction) &key
1114
                                              (context nil) (distinct t))
1115
   (declare (dynamic-extent function))
1116
   (let ((context-term (repository-context-term-number transaction context)))
1117
     (when context-term
1118
       (rlmdb:map-subject-numbers function (transaction-repository transaction)
1119
                                  :distinct distinct
1120
                                  :context context-term
1121
                                  :revision-predicate (compute-revision-predicate transaction)))))
1122
 
1123
 (defmethod map-repository-subjects (function (repository lmdb-repository) &key
1124
                                                (context nil) (distinct t))
1125
   (declare (dynamic-extent function))
1126
   (let ((context-term  (repository-context-term-number repository context)))
1127
     (when context-term
1128
       (rlmdb:map-subject-numbers function repository
1129
                                    :distinct distinct
1130
                                    :context context-term
1131
                                    :revision-predicate (compute-revision-predicate repository)))))
1132
 
1133
 (defmethod map-repository-predicates (function (transaction lmdb-transaction) &key
1134
                                                (context nil) (distinct t))
1135
   (declare (dynamic-extent function))
1136
   (let ((context-term (repository-context-term-number transaction context)))
1137
     (when context-term
1138
       (rlmdb:map-predicate-numbers function (transaction-repository transaction)
1139
                                    :distinct distinct
1140
                                    :context context-term
1141
                                    :revision-predicate (compute-revision-predicate transaction)))))
1142
 
1143
 (defmethod map-repository-predicates (function (repository lmdb-repository) &key
1144
                                                (context nil) (distinct t))
1145
   (declare (dynamic-extent function))
1146
   (let ((context-term  (repository-context-term-number repository context)))
1147
     (when context-term
1148
       (rlmdb:map-predicate-numbers function repository
1149
                                    :distinct distinct
1150
                                    :context context-term
1151
                                    :revision-predicate (compute-revision-predicate repository)))))
1152
 
1153
 
1154
 (defmethod map-repository-objects (function (transaction lmdb-transaction) &key
1155
                                             (context nil) (distinct t))
1156
   (declare (dynamic-extent function))
1157
   (let ((context-term (repository-context-term-number transaction context)))
1158
     (when context-term
1159
       (rlmdb:map-object-numbers function (transaction-repository transaction)
1160
                                :distinct distinct
1161
                                :context context-term
1162
                                :revision-predicate (compute-revision-predicate transaction)))))
1163
 
1164
 (defmethod map-repository-objects (function (repository lmdb-repository) &key
1165
                                                (context nil) (distinct t))
1166
   (declare (dynamic-extent function))
1167
   (let ((context-term  (repository-context-term-number repository context)))
1168
     (when context-term
1169
       (rlmdb:map-object-numbers function repository
1170
                                    :distinct distinct
1171
                                    :context context-term
1172
                                    :revision-predicate (compute-revision-predicate repository)))))
1173
 
1174
 ;;; matching
1175
 
1176
 
1177
 (defmethod repository-match-field ((transaction lmdb-transaction) context subject predicate object &rest args)
1178
   (declare (dynamic-extent args))
1179
   (apply #'repository-match-field (transaction-revision transaction) context subject predicate object args))
1180
 
1181
 (defmethod repository-match-field ((revision lmdb-revision) context subject predicate object &rest args
1182
                                    &key
1183
                                    (first (revision-min-revision-ordinal revision))
1184
                                    (last (revision-max-revision-ordinal revision))
1185
                                    &allow-other-keys)
1186
   (declare (dynamic-extent args))
1187
   (apply #'repository-match-field (repository-revision-reference revision) context subject predicate object
1188
          :revision-predicate (compute-revision-predicate (list :first first :last last))
1189
          args))
1190
 
1191
 
1192
 (defmethod repository-match-field ((repository lmdb-repository) context subject predicate object
1193
                                    &key (start 0) end dimensions
1194
                                    ((:wild-blank-nodes-p *wild-blank-nodes-p*) t)
1195
                                    revision-predicate)
1196
   "generate a solution sequence for the statements which match the argument pattern.
1197
  Intern all terms. Should some term not be present, then return null.
1198
  Associate a (possible sparse) dimension list with the result to indicate which columns
1199
  were variables.
1200
    The result field elements are ordered (c s p o)
1201
 
1202
    The variant for lmdb requires no rdfcache transaction, as they are read-only.
1203
    Split the retrieval and interning to limit the transactions on the string db."
1204
   (let* ((default-context-term (repository-default-context-term repository))
1205
          (dataset (task-dataset-graphs *task*))
1206
          (effective-contexts 
1207
           (cond ((null context)       (if dataset (dataset-default-graphs dataset) (list default-context-term)))
1208
                 ((variable-p context) (dataset-named-graphs dataset))
1209
                 ((typep context 'iri) (list context))
1210
                 (t
1211
                  (error "Invalid dataset specification: graph ~s, dataset ~s."
1212
                         context dataset))))
1213
          (result ())
1214
          (count 0)
1215
          (sort-dimensions ()))
1216
     (labels ((when-variable (term)
1217
                (when (variable-p term) term))
1218
              (_repository-pattern-term-number (term)
1219
                (or (repository-pattern-term-number repository term)
1220
                    (return-from repository-match-field nil)))
1221
              (collect-quad (%quad)
1222
                (when (> (incf count) start)
1223
                  (when (and end (> count end))
1224
                    (complete))
1225
                  (push (list (%quad-context %quad)
1226
                              (%quad-subject %quad)
1227
                              (%quad-predicate %quad)
1228
                              (%quad-object %quad))
1229
                        result)))
1230
              (complete ()
1231
                ;; intern and reverse
1232
                (rlmdb:with-string-database (db)
1233
                  (let ((interned-result (loop for (context subject predicate object) in (nreverse result)
1234
                                           collect (list (rlmdb:term-number-value context)
1235
                                                         (rlmdb:term-number-value subject)
1236
                                                         (rlmdb:term-number-value predicate)
1237
                                                         (rlmdb:term-number-value object)))))
1238
                    (return-from repository-match-field (values interned-result sort-dimensions))))))
1239
       (declare (dynamic-extent #'collect-quad))
1240
       (setf sort-dimensions (remove nil (or dimensions
1241
                                             (list (when-variable context)
1242
                                                   (when-variable subject)
1243
                                                   (when-variable predicate)
1244
                                                   (when-variable object)))))
1245
       (let ((interned-subject (_repository-pattern-term-number subject))
1246
             (interned-predicate (_repository-pattern-term-number predicate))
1247
             (interned-object (_repository-pattern-term-number object))
1248
             (interned-effective-contexts (loop for context in effective-contexts
1249
                                            for term-number = (repository-context-term-number repository context)
1250
                                            ;; if it is not known, there can be no result
1251
                                            when term-number
1252
                                            collect term-number))
1253
             (lmdb-repository (repository-lmdb-repository repository)))
1254
         (loop for interned-context in interned-effective-contexts
1255
           ;; would be good to get this within a single rlmdb transaction
1256
           do (rlmdb:map-repository-statements #'collect-quad lmdb-repository
1257
                     (vector interned-context
1258
                             interned-subject
1259
                             interned-predicate
1260
                             interned-object)
1261
                     :revision-predicate revision-predicate)))
1262
       (complete))))
1263
 
1264
 
1265
 
1266