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

Kind	Covered	All	%
expression	0	288	0.0
branch	0	26	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 "timestamp object databases"

6

"Implement operations specific to databases which add timestamps

7

to individual statement index keys to permit efficient retrieval by data,

8

dataTime, year, etc.

9

These add a dominant timestamp value to (g x s x p) indices.

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:object-timestamp-database : stores statements indexed by object term timestamp.

19

20

")

21

22

23

(defmethod rlmdb::map-index-statements (operator (database rlmdb::temporal-database) (quad-pattern t)

24

&key

25

                                                      (domain-predicate nil)

26

                                                      (revision-predicate nil))

27

"Iterate over statements in a timestamp object database.

28

- extract the filter's initial identifier:

29

- locate the first entry according to the initial identifier

30

- iterate as long as the optional time-series predicate is satisfied

31

- optionally filter for revision visibility

32

- collate quads with given time-series identifers into respective solutions

33

- yield each solution together with the respective time series identifier, context and subject

34

"

35

36

;;(print (list :filter filter))

37

(assert (or (null domain-predicate) (spocq.i::domain-predicate-p domain-predicate)) ()

38

"rlmdb::map-index-statements: Invalid temporal filter: ~s ~s" database domain-predicate)

39

(assert (or (null revision-predicate) (spocq.i::revision-predicate-p revision-predicate)) ()

40

"rlmdb::map-index-statements: Invalid revision filter: ~s ~s" database revision-predicate)

41

;; database should be open together with the owning repository, but ...

42

(lmdb:with-database (database)

43

(let* ((cur (lmdb:make-cursor database :transaction lmdb:*transaction*))

44

(named-only (case (graph quad-pattern)

45

((-2 |urn:dydra|:|named|) t)

46

(t nil)))

47

(graph-none (case (graph quad-pattern)

48

((-4 |urn:dydra|:|none|) t)

49

(t nil)))

50

(wild-pattern-p (wild-quad-pattern-p quad-pattern))

51

;; the object term should be wild

52

(match-count 0)

53

(scan-count 0)

54

(key-size (cffi:foreign-type-size '(:struct spocq.i::tquad)))

55

(default-graph-term-id (rlmdb:transaction-default-context-term-id lmdb:*transaction*)))

56

(cffi:with-foreign-objects ((%tquad-pattern '(:struct spocq.i::tquad))

57

(%key-tquad '(:struct spocq.i::tquad)))

58

(lmdb::with-empty-value (raw-key)

59

(lmdb::with-empty-value (raw-value)

60

(flet ((map-for-graph (quad-pattern)

61

;; if a term object quad is given a nil result indicates

62

;; that some term is not in the store, which means there

63

;; can be no match.

64

(quad-to-tquad-record quad-pattern %tquad-pattern)

65

;; if the patter has a wild time term

66

;; and a predicate is supplied which has a minium constraint

67

;; modify the pattern to start at 1- that constraint,

68

;; which allows for both < and <=

69

(when (and (zerop (%tquad-time %tquad-pattern))

70

domain-predicate

71

(spocq.i::domain-predicate-min domain-predicate))

72

(let ((min (spocq.i::domain-predicate-min domain-predicate)))

73

(when min

74

(setf (%tquad-time %tquad-pattern)

75

                                  (case (spocq.i::domain-predicate-min-op domain-predicate)

76

(spocq.a:> (1+ min))

77

(t min)))

78

(print (list min domain-predicate)))))

79

(%copy-tquad %tquad-pattern %key-tquad)

80

(lmdb:with-cursor (cur)

81

(let ((%cursor (lmdb::handle cur)))

82

(labels ((get-entry (get-op)

83

(ecase get-op

84

(:+set-range+

85

(setf (%mdb-val-size raw-key) key-size

86

                                            (%mdb-val-data raw-key) %key-tquad))

87

(:+next+ ))

88

                                   (let ((return-code (liblmdb:cursor-get %cursor raw-key raw-value get-op)))

89

(alexandria:switch (return-code)

90

(0

91

                                                         (call-with-entry raw-key raw-value))

92

                                                        (liblmdb:+notfound+

93

nil)

94

(t

95

                                                         (lmdb::unknown-error return-code)))))

96

(call-with-entry (k v)

97

(assert (= key-size (%mdb-val-size k)) ()

98

                                           "rlmdb::map-index-statements: Invalid key size: ~s ~s" database (%mdb-val-size k))

99

(let* ((%index-tquad (%mdb-val-data k))

100

                                          (visibility-bytes (%mdb-val-size v)))

101

                                     ;; continue until either no longer matched

102

                                     (cond ((and named-only (=  (spocq.i::%tquad-context %index-tquad) default-graph-term-id))

103

;; skip

104

t)

105

                                           ((if domain-predicate ;; if there is a predicate, it controls

106

                                                (funcall-domain-predicate domain-predicate (spocq.i::%tquad-time %index-tquad))

107

(or wild-pattern-p

108

                                                    (%quad-match-p %tquad-pattern %index-tquad)))

109

                                            (when (or (zerop visibility-bytes)

110

                                                      (null revision-predicate)

111

                                                      ;; for bi-temporal cases

112

                                                      (funcall revision-predicate (%mdb-val-data v) visibility-bytes))

113

                                              ;; iff still in range, satisfying predicate and visible, then match

114

                                              (map-object-timestamp-database-callback operator %index-tquad)

115

(incf match-count))

116

(incf scan-count))

117

(t

118

;; otherwise end

119

nil)))))

120

(loop for op = :+set-range+ then :+next+

121

while (get-entry op)))))))

122

               (typecase (graph quad-pattern) ;; if a set enumerate, otherwise scan the single graph

123

(cons (loop with single-graph-quad-pattern = (copy-quad-pattern quad-pattern)

124

for graph in (graph quad-pattern)

125

do (progn (setf (graph single-graph-quad-pattern) graph)

126

(map-for-graph single-graph-quad-pattern))))

127

(t (unless graph-none

128

(when named-only ;; with special handling for named graphs

129

(setf (graph quad-pattern) 0))

130

(map-for-graph quad-pattern))))))))

131

(values scan-count match-count))))

132

133

(defun funcall-domain-predicate (domain-predicate time)

134

(funcall domain-predicate time))

135

136

(defun map-object-timestamp-database-callback (operator xquad)

137

#+(or)

138

(when cl-user::*map-index-statements-callback.verbose*

139

(let ((quad-string (with-output-to-string (stream) (spocq.i::%print-tquad xquad stream))))

140

(format *trace-output* "mrs: ~a" quad-string)))

141

(funcall operator xquad))

142

143

144

(defmethod rlmdb::repository-insert-statement

145

   ((repository rlmdb::temporal-index-repository) (transaction rlmdb:transaction) graph subject predicate object)

146

"Add statements with temporal predicates to the temporal indices"

147

(when (rlmdb:repository-temporal-predicate-p repository predicate)

148

(let ((timestamp (rlmdb:term-timestamp object))) ;; it has already been inserted if new

149

(when timestamp

150

(cffi:with-foreign-objects ((%key-quad '(:struct tquad)))

151

           (with-lmdb-values ((%key (load-time-value (cffi:foreign-type-size '(:struct tquad))) %key-quad))

152

(setf (%tquad-context %KEY-quad) graph

153

(%tquad-subject %KEY-quad) subject

154

(%tquad-predicate %KEY-quad) predicate

155

(%tquad-object %KEY-quad) object

156

(%tquad-time %KEY-quad) timestamp)

157

(let* ((db (aref (repository-temporal-databases repository) 0)))

158

(multiple-value-bind (index-data operation)

159

                                    (rlmdb::compute-index-insertion-data db transaction %key)

160

(ecase operation

161

((nil)

162

;; no change

163

nil)

164

(:put

165

;; either the statement is not present, in which case it is added

166

                    ;; or the statement is already present and the data is to be replaced

167

(let* ((ordinal-size (repository-ordinal-size repository))

168

(record-length (* (length index-data) ordinal-size)))

169

                      ;; for a null-record-database, this would out to inserting the key with a zero-length record

170

                      ;; for an ordinal record database, with flags=0, the index entry is overwritten.

171

(cffi:with-foreign-pointer (%index-record record-length)

172

(with-lmdb-values ((%value record-length %index-record))

173

(loop for i below (length index-data)

174

                            do (setf (cffi:mem-aref %index-record 'spocq.i::revision-ordinal i) (aref index-data i)))

175

                          (loop with index-databases = (repository-temporal-databases repository)

176

for db across index-databases

177

                            do (let ((return-code (liblmdb:put (lmdb::handle transaction) (lmdb::handle db) %key %value 0)))

178

(unless (zerop return-code)

179

(lmdb::unknown-error return-code)))))))

180

t)))))))))

181

(call-next-method))

182

183

(defmethod rlmdb::repository-delete-statement any

184

   ((repository rlmdb::temporal-index-repository) (transaction rlmdb:transaction) graph subject predicate object)

185

"Delete statements with temporal predicates from the temporal indices"

186

(when (rlmdb:repository-temporal-predicate-p repository predicate)

187

(let ((timestamp (rlmdb:term-timestamp object)))

188

(when timestamp

189

(cffi:with-foreign-objects ((%key-quad '(:struct tquad)))

190

           (with-lmdb-values ((%key (load-time-value (cffi:foreign-type-size '(:struct tquad))) %key-quad))

191

(setf (%tquad-context %KEY-quad) graph

192

(%tquad-subject %KEY-quad) subject

193

(%tquad-predicate %KEY-quad) predicate

194

(%tquad-object %KEY-quad) object

195

(%tquad-time %KEY-quad) timestamp)

196

(let* ((db (aref (repository-temporal-databases repository) 0)))

197

(multiple-value-bind (index-data operation)

198

                                    (rlmdb::compute-index-deletion-data db transaction %key)

199

(case operation

200

((nil) ;; nothing to change

201

nil)

202

(:put

203

                    ;; if the statement is already present and the data is to be modified

204

(let* ((ordinal-size (repository-ordinal-size repository))

205

(record-length (* (length index-data) ordinal-size)))

206

(cffi:with-foreign-pointer (%index-record record-length)

207

(with-lmdb-values ((%value record-length %index-record))

208

(loop for i below (length index-data)

209

                            do (setf (cffi:mem-aref %index-record :uint32 i) (aref index-data i)))

210

                          (loop with index-databases = (repository-temporal-databases repository)

211

for db across index-databases

212

                            do (let ((return-code (liblmdb:put (lmdb::handle transaction) (lmdb::handle db) %key %value 0)))

213

(unless (zerop return-code)

214

(lmdb::unknown-error return-code)))))))

215

t)

216

(:del

217

(loop with index-databases = (repository-temporal-databases repository)

218

for db across index-databases

219

                      do (let ((return-code (liblmdb:del (lmdb::handle transaction) (lmdb::handle db) %key (cffi:null-pointer))))

220

(unless (zerop return-code)

221

(lmdb::unknown-error return-code))))

222

t)))))))))

223

(call-next-method))

224

225

226