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

KindCoveredAll%
expression0237 0.0
branch018 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.rlmdb.implementation; -*-
2
 
3
 (in-package :rlmdb.i)
4
 
5
 (:documentation "quad index databases"
6
                 "Implement operations for a simple quad index:
7
  Initialization includes setting the sort function respective the sort order for the
8
  (g x s x p x o) key
9
 
10
  All permit the index record to be either
11
  - null : retains the lastest state only
12
  - ordinal-vector : interpreted as an insertion/deletion linear index
13
  - uuid-vector : interpreted as a replication record
14
 
15
  Mapping over index entries treats the key values uniformly independent of sort order.
16
 
17
  Classes
18
  - rlmdb:quad-database : stores statements indexed by object term timestamp.
19
 
20
  Methods:
21
  - rlmdb::map-index-statements : iterate over all matched entries
22
  - rlmdb::repository-insert-statement : insert a quad or mark its revision index
23
  - rlmdb::repository-delete-statement : delete a quad or mark its revision index
24
 ")
25
 
26
 
27
 (defmethod rlmdb::map-index-statements (operator (database rlmdb::quad-database) (quad-pattern t)
28
                                                      &key
29
                                                      domain-predicate
30
                                                      (revision-predicate nil))
31
   "Match and scan the index as constrained by a given pattern.
32
    The matched are always null records, as this index is un-revisioned, so the bounds do not count."
33
   (declare (ignore domain-predicate))
34
   (assert (or (null revision-predicate) (spocq.i::revision-predicate-p revision-predicate)) ()
35
           "rlmdb::map-index-statements: Invalid revision filter: ~s ~s" database revision-predicate)
36
   ;; database should be open together with the owning repository, but ...
37
   (lmdb:with-database (database)
38
     (let* ((cur (lmdb:make-cursor database :transaction lmdb:*transaction*))
39
            (named-only (case (graph quad-pattern)
40
                          ((-2 |urn:dydra|:|named|) t)
41
                          (t nil)))
42
            (graph-none (case (graph quad-pattern)
43
                          ((-4 |urn:dydra|:|none|) t)
44
                          (t nil)))
45
            (wild-pattern-p (wild-quad-pattern-p quad-pattern))
46
            (match-count 0)
47
            (scan-count 0)
48
            (key-size (load-time-value (cffi:foreign-type-size '(:struct spocq.i::quad))))
49
            (default-graph-term-id (rlmdb:transaction-default-context-term-id lmdb:*transaction*)))
50
       (cffi:with-foreign-objects ((%quad-pattern '(:struct spocq.i::quad))
51
                                   (%key-quad '(:struct spocq.i::quad)))
52
         (lmdb::with-empty-value (raw-key)
53
           (lmdb::with-empty-value (raw-value)
54
             (flet ((map-for-graph (quad-pattern)
55
                      ;; if a term object quad is given a nil result indicates
56
                      ;; that some term is not in the store, which means there
57
                      ;; can be no match.
58
                      (unless (quad-to-quad-record quad-pattern %quad-pattern)
59
                        (return-from map-for-graph nil))
60
                      (%copy-quad %quad-pattern %key-quad)
61
                      (lmdb:with-cursor (cur)
62
                        (let ((%cursor (lmdb::handle cur)))
63
                          (labels ((get-quad (get-op)
64
                                   (ecase get-op
65
                                     (:+set-range+
66
                                      (setf (%mdb-val-size raw-key) key-size
67
                                            (%mdb-val-data raw-key) %key-quad))
68
                                     (:+next+ ))
69
                                   (let ((return-code (liblmdb:cursor-get %cursor raw-key raw-value get-op)))
70
                                     (alexandria:switch (return-code)
71
                                                        (0
72
                                                         (call-with-entry raw-key raw-value))
73
                                                        (liblmdb:+notfound+
74
                                                         nil)
75
                                                        (t
76
                                                         (lmdb::unknown-error return-code)))))
77
                                 (call-with-entry (k v)
78
                                   (assert (= key-size (%mdb-val-size k)) ()
79
                                           "rlmdb::map-index-statements: key size is invalid: ~s ~s" database (%mdb-val-size k))
80
                                   (let* ((%index-quad (%mdb-val-data k))
81
                                          (visibility-bytes (%mdb-val-size v)))
82
                                     ;; continue until either no longer matched or the operator returns nil
83
                                     (cond ((and named-only (= (%quad-context %index-quad) default-graph-term-id))
84
                                            ;; skip
85
                                            t)
86
                                           ((or wild-pattern-p (%quad-match-p %quad-pattern %index-quad))
87
                                            ;; iff still in range, match
88
                                            (when (or (zerop visibility-bytes)
89
                                                      (null revision-predicate)
90
                                                      (funcall revision-predicate (%mdb-val-data v) visibility-bytes))
91
                                              ;; iff still in range, satisfying predicate and visible, then match
92
                                              (map-quad-database-callback operator %index-quad)
93
                                              (incf match-count))
94
                                            (incf scan-count))
95
                                           (t
96
                                            ;; otherwise end
97
                                            nil)))))
98
                      (loop for op = :+set-range+ then :+next+
99
                        while (get-quad op)))))))
100
           (typecase (graph quad-pattern) ;; if a set enumerate, other wise scan the single graph
101
             (cons (loop with single-graph-quad-pattern = (copy-quad-pattern quad-pattern)
102
                     for graph in (graph quad-pattern)
103
                     do (progn (setf (graph single-graph-quad-pattern) graph)
104
                          (map-for-graph single-graph-quad-pattern))))
105
             (t (unless graph-none
106
                  (when named-only ;; with special handling for named graphs
107
                    (setf (graph quad-pattern) 0))
108
                  (map-for-graph quad-pattern))))))))
109
       ;; should happen in the bgp processor, not here (incf spocq.i::*match-responses* match-count)
110
       (values scan-count match-count))))
111
 
112
 (defun map-quad-database-callback (operator quad)
113
   #+(or)
114
   (when cl-user::*map-index-statements-callback.verbose*
115
     (let ((quad-string (with-output-to-string (stream) (spocq.i::%print-quad quad stream))))
116
       (format *trace-output* "mrs: ~a" quad-string)))
117
   (funcall operator quad))
118
 
119
 
120
 (defmethod rlmdb::repository-insert-statement
121
   ((repository rlmdb::quad-index-repository) (transaction rlmdb:transaction) graph subject predicate object)
122
   "If a quad index is present, and applied, it alswys accepts the statement"
123
   (cffi:with-foreign-objects ((%key-quad '(:struct quad)))
124
     (with-lmdb-values ((%key (load-time-value (cffi:foreign-type-size '(:struct quad))) %key-quad))
125
       (setf (%quad-context %KEY-quad) graph
126
             (%quad-subject %KEY-quad) subject
127
             (%quad-predicate %KEY-quad) predicate
128
             (%quad-object %KEY-quad) object)
129
       (let* ((db (aref (repository-quad-databases repository) 0)))
130
         (multiple-value-bind (index-data operation)
131
                              (rlmdb::compute-index-insertion-data db transaction %key)
132
           (ecase operation
133
             ((nil) ;; no change
134
              nil)
135
             (:put
136
              ;; either the statement is not present, in which case it is added
137
              ;; or the statement is already present and the data is to be replaced
138
              (let* ((ordinal-size (repository-ordinal-size repository))
139
                     (record-length (* (length index-data) ordinal-size)))
140
                ;; for a null-record-database, this would out to inserting the key with a zero-length record
141
                ;; for an ordinal record database, with flags=0, the index entry is overwritten.
142
                (cffi:with-foreign-pointer (%index-record record-length)
143
                  (with-lmdb-values ((%value record-length %index-record))
144
                    (loop for i below (length index-data)
145
                      do (setf (cffi:mem-aref %index-record :uint32 i) (aref index-data i)))
146
                    (loop with index-databases = (repository-quad-databases repository)
147
                      for db across index-databases
148
                      do (let ((return-code (liblmdb:put (lmdb::handle transaction) (lmdb::handle db) %key %value 0)))
149
                           (unless (zerop return-code)
150
                             (lmdb::unknown-error return-code)))))))
151
              t)))))))
152
 
153
 
154
 
155
 
156
 (defmethod rlmdb::repository-delete-statement any
157
   ((repository rlmdb::quad-index-repository) (transaction rlmdb:transaction) graph subject predicate object)
158
   (cffi:with-foreign-objects ((%key-quad '(:struct quad)))
159
     (with-lmdb-values ((%key (load-time-value (cffi:foreign-type-size '(:struct quad))) %key-quad))
160
       (setf (%quad-context %KEY-quad) graph
161
             (%quad-subject %KEY-quad) subject
162
             (%quad-predicate %KEY-quad) predicate
163
             (%quad-object %KEY-quad) object)
164
       (let* ((db (aref (repository-quad-databases repository) 0)))
165
         (multiple-value-bind (index-data operation)
166
                              (rlmdb::compute-index-deletion-data db transaction %key)
167
           (case operation
168
             ((nil) ;; nothing to change
169
              nil)
170
             (:put
171
              ;; if the statement is already present and the data is to be modified
172
              (let* ((ordinal-size (repository-ordinal-size repository))
173
                     (record-length (* (length index-data) ordinal-size)))
174
                (cffi:with-foreign-pointer (%index-record record-length)
175
                  (with-lmdb-values ((%value record-length %index-record))
176
                    (loop for i below (length index-data)
177
                      do (setf (cffi:mem-aref %index-record :uint32 i) (aref index-data i)))
178
                    (loop with index-databases = (repository-quad-databases repository)
179
                      for db across index-databases
180
                      do (let ((return-code (liblmdb:put (lmdb::handle transaction) (lmdb::handle db) %key %value 0)))
181
                           (unless (zerop return-code)
182
                             (lmdb::unknown-error return-code)))))))
183
              t)
184
             (:del
185
              (loop with index-databases = (repository-quad-databases repository)
186
                for db across index-databases
187
                do (let ((return-code (liblmdb:del (lmdb::handle transaction) (lmdb::handle db) %key (cffi:null-pointer))))
188
                     (unless (zerop return-code)
189
                       (lmdb::unknown-error return-code))))
190
              t)))))))
191
 
192
 ;;; (rlmdb.i::read-index (spocq.i:repository-pathname (repository "test/test-revisioned-repository")) "gpos" :limit 2)
193
 #+(or)
194
 (
195
 (rlmdb.i::read-index (spocq.i:repository-pathname (repository "test/test-revisioned-repository")) "gpos"
196
                      :limit 2
197
                      :quad-pattern (vector #xffffffff
198
                                            (object-term-number (intern-iri "http://example.com/default-subject"))
199
                                            (object-term-number (intern-iri "http://example.com/default-predicate"))
200
                                            (object-term-number "object 0")))
201
 (rlmdb.i::read-index (spocq.i:repository-pathname (repository "test/test-revisioned-repository")) "gpos"
202
                      :limit 2
203
                      :quad-pattern (vector #xffffffff
204
                                            (object-term-number (intern-iri "http://example.com/default-subject"))
205
                                            (object-term-number (intern-iri "http://example.com/default-predicate"))
206
                                            (object-term-number "revised object 0")))
207
 (spocq.i::test-sparql "select * where { <http://example.com/default-subject> <http://example.com/default-predicate> ?o} limit 3"
208
                       :repository-id "test/test-revisioned-repository")
209
 (spocq.i::test-sparql "select * where { <http://example.com/default-subject> <http://example.com/default-predicate> 'revised object 2'}"
210
                       :repository-id "test/test-revisioned-repository")
211
 (spocq.i::test-sparql "select count(*) where { ?s ?p ?o}"
212
                       :repository-id "test/test-revisioned-repository")
213
 
214
 (spocq.i::test-sparql "select * where { <http://example.com/default-subject> <http://example.com/default-predicate> ?o} limit 3"
215
              :repository-id "test/test-revisioned-repository"
216
              :revision-id 35)
217
 (rlmdb.i::test-ordinal-visibility 38 #(35 36 36 37 37 38 38) 7)
218
 )
219
 
220