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

Kind	Covered	All	%
expression	239	682	35.0
branch	11	42	26.2

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.implementation; -*-

2

3

(in-package :org.datagraph.spocq.implementation)

4

5

(:documentation "This file defines repository operators for the 'org.datagraph.spocq' RDF engine,

6

specific to the rdfcache store."

7

8

(copyright

9

10

11

(long-description

12

   "When tracking modifications, the effect of a transaction on a the dataset's graphs is recorded in three

13

senses:

14

- created : any explicit creation and any insertion for which the graph did not already exist;

15

- deleted : an explicit drop operation, but neither dlearing nor deleting statements;

16

- modified : any other update.

17

in terms of operations, this means

18

add-graph : if to exists, it is modified, otherwise created

19

clear-graph : if exists, it is modified

20

copy-graph : if to exists, it is modified, otherwise created

21

move : if the from exists, it is deleted; if the to exists, it is modified

22

create : if it does not exist, created

23

load : if it does not exist, created

24

"))

25

26

27

(:documentation "transactions"

28

"The queries and updates operate on individual revisions of the store repository. A query retrieves

29

  isolated statements while an update also inserts or deletes statements relative to an isolated initial state.

30

  A task can comprise several individual forms, each of which executes in one or more independent threads and

31

each of which can succeed or fail.

32

33

The following mechanism permits multi-threaded task processing to fulfill acid requirements:

34

  - Each task is associated with a transaction. The transaction has indefinite extent analogous to the task

35

itself.

36

- The transaction is created on demand and remains bound to the task.

37

- The transaction is closed when the task completes successfully or fails.

38

  - The transaction initial state is 'uninitialized'. opening changes that to 'initialized', but does not add

39

   anything which would affect the repository's persistent state. read operations change the state to 'read',

40

write to 'write', and a combination to 'read+write'.

41

- The transaction initial disposition is 'continue'. With this disposition, no change occurs to the

42

persistent repository state upon close.

43

- The transaction disposition 'commit' causes changes to be persisted upon close.

44

- The transaction disposition 'abort' causes no change ot the persistent repository state.

45

  - Disposition can change from 'continue' to either 'commit' or 'abort' and from 'commit' to 'abort'. Other

46

attempts to change have no effect.

47

- The form 'with-transaction' establishes a dynamic extent for repository operations which is bounded

48

   by an initial 'open' and a final 'close'. Each form declares disposition changes for normal completion

49

   and for abnormal completion. The form prepends an initial transaction 'open' to the body and protects it

50

   with final transaction 'close'. The close applies the disposition declared for the respective normal /

51

abnormal control flow at that point.

52

53

Several threads cooperate in order to process a task.

54

- A request thread parses, compiles, and initializes the task

55

- A response thread emits the result document as a response

56

  - One or more algebra threads retrieve query results, compute algebraic combinations, or insert or delete

57

statements as per the request.

58

59

  The processes cooperate in their use of 'with-transaction' to arrive at a final disposition. Control flows

60

  from the response thread to a thread for each bgp match (if present) and then to one for each insert or

61

  delete operation. Conrol over completion is passed back ultimately to the response thread as the query

62

  or update results are reported to it for it to generate the response document. Each thread establishes its

63

  own 'with-transaction' context with dispositions to cause the overall process to persist changes when it

64

succeeds and to abort them if it fails.

65

  - The response process creates and opens the transaction as the first step and declares the normal/abnormal

66

dispositions 'commit'/'abort'.

67

- Each algebra thread opens what it expects to be an existing transaction and declares dispositions

68

'continue'/'abort'.

69

70

  As the response thread completes only once the algebra threads have completed - whether having succeeded or

71

failed, their respective disposition will have been registered in the transaction's state. Their normal

72

disposition leaves the transaction unchanged. Their abnormal disposition fixes it to abort. When the

73

  response thread completes normally, it attempts to commit, which succeeds if no other thread has aborted.

74

If the response thread completes abnormally, it forces an abort itself.

75

76

  In effect, this pattern accomplishes the first two steps (preparation and voting) of a two-phase commit. The

77

third step, reporting, is not necessary as the constituent threads control no persistent state.")

78

79

80

81

82

 (defparameter *rdfcache-revision-root* (make-pathname :directory '(:absolute "var" "lib" "rdfcache" "revisions")))

83

84

(defmethod revision-parent-uri ((transaction rdfcache-transaction))

85

(when-transaction-record (%record transaction)

86

#+parent-revision-is-in-transaction

87

(when (rdfcache:transaction-parent-revision-p %record)

88

       (intern-iri (format nil "urn:dydra:revision:~a" (rdfcache:transaction-parent-revision-uuid-string %record))))

89

#-parent-revision-is-in-transaction

90

     (let* ((path (format nil "~a/~a/.parent" (namestring *rdfcache-revision-root*) (rdfcache:transaction-uuid-string %record)))

91

(parent-path (probe-file path))

92

(id (when parent-path (first (last (pathname-directory parent-path))))))

93

(when (and id (not (equalp id "dev")))

94

(intern-iri (format nil "urn:dydra:revision:~a" id))))))

95

96

(defmethod repository-write-date ((repository rdfcache-repository))

97

   (let ((truename (probe-file (make-pathname :name "data" :type "mdb" :defaults (repository-pathname repository)))))

98

(when truename

99

(file-write-date truename))))

100

101

(defmethod repository-revision-write-date ((repository rdfcache-repository) (revision-id string))

102

;; ignore the version

103

   (let ((truename (probe-file (make-pathname :name "data" :type "mdb" :defaults (repository-pathname repository)))))

104

(when truename

105

(file-write-date truename))))

106

107

(defmethod repository-metadata-file ((repository rdfcache-repository))

108

(let* ((repository-id (repository-id repository))

109

(catalog-pathname (repository-pathname repository-id))

110

(statistics-pathname (make-pathname :name "stats" :type "json" :defaults catalog-pathname)))

111

(when (probe-file statistics-pathname)

112

(parse-json statistics-pathname))))

113

114

(defmethod repository-uuid ((repository repository))

115

(let ((catalog-pathname (repository-catalog-pathname (repository-id repository))))

116

(when catalog-pathname

117

(first (last (pathname-directory catalog-pathname))))))

118

(defmethod repository-uuid ((repository-id string))

119

(let ((catalog-pathname (repository-catalog-pathname repository-id)))

120

(when catalog-pathname

121

(first (last (pathname-directory catalog-pathname))))))

122

123

(defgeneric account-repository-pathname (repository)

124

   (:documentation "Return the symbolic link located relative to the account, not the actual repository directory.")

125

(:method ((repository-id string))

126

(multiple-value-bind (account-name repository-name)

127

(parse-repository-id repository-id)

128

(assert (and account-name repository-name) ()

129

"account-repository-pathname: invalid repository-id: ~s" repository-id)

130

       (merge-pathnames (make-pathname :directory `(:relative "accounts" ,account-name "repositories" ,repository-name))

131

*metadata-root-pathname*)))

132

(:method ((repository repository))

133

(let ((account-name (account-name (repository-account repository)))

134

(repository-name (repository-name repository)))

135

       (merge-pathnames (make-pathname :directory `(:relative "accounts" ,account-name "repositories" ,repository-name))

136

*metadata-root-pathname*))))

137

138

(defgeneric repository-catalog-pathname (repository)

139

(:documentation "Return the actual repository directory which is found be following

140

the symbolic link located relative to the account.")

141

(:method ((repository-id string))

142

(let ((link (account-repository-pathname repository-id)))

143

(when (probe-file link)

144

         ;; resolve the symbolic link to the uuid value and combine that with the repository tree.

145

         ;; 202009: nb, probe-file applied to the link file name returns nonsense in which the uuid replaces the account name

146

         (merge-pathnames (make-pathname :directory `(:relative "repositories" ,(sb-posix:readlink link)))

147

*metadata-root-pathname*))))

148

(:method ((repository repository))

149

(let ((link (account-repository-pathname repository)))

150

(when (probe-file link)

151

         ;; resolve the symbolic link to the uuid value and combine that with the repository tree.

152

         (merge-pathnames (make-pathname :directory `(:relative "repositories" ,(sb-posix:readlink link)))

153

*metadata-root-pathname*)))))

154

155

(defgeneric repository-pathname (repository)

156

(:documentation "If the repository caches the value, compute it on-demand.

157

Otherwise, generate it based on the catalog location.")

158

(:method ((repository t))

159

(repository-catalog-pathname repository))

160

(:method ((repository rdfcache-repository))

161

(or (get-repository-pathname repository)

162

(setf-repository-pathname (repository-catalog-pathname repository)

163

repository))))

164

165

;;;

166

;;; interning

167

168

169

#+(or) ; obsolete

170

(defgeneric repository-make-ephemeral-term-cache (repository)

171

(:method ((repository rdfcache-repository))

172

(rdfcache::make-ephemeral-term-cache)))

173

174

175

;;;

176

;;; dataset managment operations

177

178

;;; the base operators accepts unrestricted arguments as iri terms and

179

;;; delegates to the respective rdfcache library operator.

180

;;; the integer methods will have mapped the erm numbers to strings or pointers

181

;;; strings, in general and pointers for the default/all arguments.

182

183

(defmethod sparql-add ((%transaction t) (graph1-uri t) (graph2-uri t) &optional silent)

184

(rdfcache:sparql-add %transaction graph1-uri graph2-uri silent))

185

186

(defmethod sparql-clear ((%transaction t) (graph-uri t) &optional silent)

187

(rdfcache:sparql-clear %transaction graph-uri silent))

188

189

(defmethod sparql-copy ((%transaction t) (graph1-uri t) (graph2-uri t) &optional silent)

190

(rdfcache:sparql-copy %transaction graph1-uri graph2-uri silent))

191

192

(defmethod sparql-create ((%transaction t) (graph-uri t) &optional silent)

193

(rdfcache:sparql-create %transaction graph-uri silent))

194

195

(defmethod sparql-drop ((%transaction t) (graph-uri t) &optional silent)

196

(rdfcache:sparql-drop %transaction graph-uri silent))

197

198

(defmethod sparql-load ((%transaction t) (graph-uri t) (from-url t) &optional silent)

199

(rdfcache:sparql-load %transaction graph-uri from-url silent))

200

201

(defmethod sparql-move ((%transaction t) (graph1-uri t) (graph2-uri t) &optional silent)

202

(rdfcache:sparql-move %transaction graph1-uri graph2-uri silent))

203

204

(defgeneric repository-binary-graph-operation (handle from-graph to-graph operation &key if-does-not-exist)

205

(:method ((repository rdfcache-repository) from-graph to-graph operation &rest args)

206

(declare (dynamic-extent args))

207

(apply #'repository-binary-graph-operation *transaction* from-graph to-graph operation args))

208

(:method ((transaction rdfcache-transaction) from-graph to-graph operation &key (if-does-not-exist nil))

209

(let ((from-graph-term-number (repository-graph-term-number transaction from-graph :allow-all t))

210

(to-graph-term-number (repository-graph-term-number transaction to-graph))

211

(%transaction (transaction-record transaction)))

212

(cond ((repository-pattern-match-p transaction 0 0 0 from-graph-term-number)

213

(setf (transaction-graph-id-read transaction from-graph-term-number) t)

214

(if (repository-pattern-match-p transaction 0 0 0 to-graph-term-number)

215

(setf (transaction-graph-id-modified transaction to-graph-term-number) t)

216

(setf (transaction-graph-id-created transaction to-graph-term-number) t))

217

(funcall operation %transaction

218

(graph-management-argument from-graph)

219

(graph-management-argument to-graph)))

220

(t

221

(ecase if-does-not-exist

222

                       (:error (spocq.e::graph-not-found-error :identifier from-graph :operation operation))

223

((nil) ))))

224

spocq.a:|true|)))

225

226

227

(defgeneric repository-add-graph (repository-handle from-graph to-graph &key if-does-not-exist)

228

(:documentation "Add the contents of from-graph of the repository to that if its to-graph.

229

Each may be either an iri or the keyword :default.

230

If the :default graph is specified, operate on the static default graph, without allowing for

231

the default/named/all option.

232

    If the destination named graph does not yet exist, record its creation. Otherwise just note modification.

233

If the from--graph does not exist, signal an error.")

234

235

(:method ((repository rdfcache-repository) from-graph to-graph &rest args)

236

237

(declare (dynamic-extent args))

238

(apply #'repository-add-graph *transaction* from-graph to-graph args))

239

240

(:method ((transaction rdfcache-transaction) from-graph to-graph &rest args)

241

(declare (dynamic-extent args))

242

(apply #'repository-binary-graph-operation *transaction* from-graph to-graph 'sparql-add args)))

243

244

245

(defgeneric repository-clear-graph (repository-handle graph-designator &key if-does-not-exist)

246

(:documentation "Clear the designated graph.

247

If the :default graph is specified, operate on the static default graph, without allowing for

248

the default/named/all option.

249

Record the graph as modified, but not deleted - leave that for repository-delete-graph.")

250

251

(:method ((repository rdfcache-repository) graph-designator &rest args)

252

(declare (dynamic-extent args))

253

(if *transaction*

254

(apply #'repository-clear-graph *transaction* graph-designator args)

255

         (with-open-transaction ((repository-id repository) :revision-id "HEAD" :normal-disposition :commit)

256

(apply #'repository-clear-graph *transaction* graph-designator args))))

257

258

(:method ((transaction rdfcache-transaction) (graph-designator t) &key if-does-not-exist)

259

(typecase graph-designator

260

((or keyword boolean)

261

(or (ecase graph-designator

262

((:default nil)

263

               (when (plusp (repository-pattern-count transaction 0 0 0 rlmdb:*default-context-number*))

264

(sparql-clear (transaction-record transaction)

265

rdfcache:*default-context-number*)

266

                 (setf (transaction-graph-id-modified transaction rdfcache:*default-context-number*) t)

267

t))

268

((:all t)

269

(let ((%transaction (transaction-record transaction))

270

(count 0))

271

(when (plusp (repository-pattern-count transaction 0 0 0 0))

272

(do-repository-contexts (context :transaction transaction :default t)

273

                                           (sparql-clear %transaction context)

274

                                           (setf (transaction-graph-id-modified transaction context) t)

275

(incf count)))

276

(plusp count)))

277

(:named

278

(let ((%transaction (transaction-record transaction))

279

(count 0))

280

(do-repository-contexts (context :transaction transaction :default nil)

281

(sparql-clear %transaction context)

282

                                         (setf (transaction-graph-id-modified transaction context) t)

283

(incf count))

284

(plusp count))))

285

(ecase if-does-not-exist

286

(:error (spocq.e::graph-not-found-error

287

:identifier (ecase graph-designator

288

((nil :default) |urn:dydra|:|default|)

289

((:all t) |urn:dydra|:|all|)

290

(:named |urn:dydra|:|named|))

291

:operation 'repository-clear-graph))

292

((nil) nil))))

293

(iri

294

(case graph-designator

295

          (|urn:dydra|:|default| (repository-clear-graph transaction :default :if-does-not-exist if-does-not-exist))

296

          (|urn:dydra|:|named| (repository-clear-graph transaction :named :if-does-not-exist if-does-not-exist))

297

          (|urn:dydra|:|all| (repository-clear-graph transaction :all :if-does-not-exist if-does-not-exist))

298

(t

299

(let ((%transaction (transaction-record transaction))

300

(graph-term-number (repository-object-term-number transaction graph-designator)))

301

(cond ((plusp (repository-pattern-count transaction 0 0 0 graph-term-number))

302

(setf (transaction-graph-id-modified transaction graph-term-number) t)

303

(sparql-clear %transaction (iri-lexical-form graph-designator))

304

t)

305

(t

306

(ecase if-does-not-exist

307

                       (:error (spocq.e::graph-not-found-error :identifier graph-designator :operation 'repository-clear-graph))

308

((nil) nil))))))))

309

(t

310

(ecase if-does-not-exist

311

          (:error (spocq.e::invalid-graph-error :identifier graph-designator :operation 'repository-clear-graph))

312

((nil) nil))))))

313

314

315

(defgeneric repository-copy-graph (repository-handle from-graph to-graph &key if-does-not-exist)

316

(:documentation "Copy between the designated graphs.

317

Each may be either an iri or the keyword :default.

318

If the :default graph is specified, operate on the static default graph, without allowing for

319

the default/named/all option.

320

    If the destination named graph does not yet exist, record its creation. Otherwise just note modification.

321

If the from--graph does not exist, signal an error.")

322

323

(:method ((repository rdfcache-repository) from-graph to-graph &rest args)

324

(declare (dynamic-extent args))

325

(apply #'repository-copy-graph *transaction* from-graph to-graph args))

326

327

(:method ((transaction rdfcache-transaction) from-graph to-graph &rest args)

328

(declare (dynamic-extent args))

329

(apply #'repository-binary-graph-operation *transaction* from-graph to-graph 'sparql-copy args)))

330

331

332

(defgeneric repository-create-graph (repository-handle graph &key if-exists)

333

334

(:method ((repository rdfcache-repository) graph-designator &rest args)

335

(apply #'repository-create-graph *transaction* graph-designator args))

336

337

(:method ((transaction rdfcache-transaction) (graph-designator t) &key if-exists)

338

(etypecase graph-designator

339

((or keyword boolean)

340

(ecase if-exists

341

          (:error (spocq.e::invalid-graph-error :identifier graph-designator :operation 'repository-create-graph))

342

((nil) )))

343

(iri

344

(case graph-designator

345

(|urn:dydra|:|default| (repository-create-graph transaction :default :if-exists if-exists))

346

(|urn:dydra|:|named| (repository-create-graph transaction :named :if-exists if-exists))

347

(|urn:dydra|:|all| (repository-create-graph transaction :all :if-exists if-exists))

348

(t

349

(let ((graph-term-number (repository-object-term-number transaction graph-designator)))

350

(cond ((plusp (repository-pattern-count transaction 0 0 0 graph-term-number))

351

(ecase if-exists

352

                      (:error (spocq.e::graph-found-error :identifier graph-designator :operation 'repository-create-graph))

353

((nil) )))

354

(t

355

(setf (transaction-graph-id-created transaction graph-term-number) t)

356

(sparql-create (transaction-record transaction)

357

                                             (iri-lexical-form graph-designator)))))))))

358

spocq.a:|true|))

359

360

361

(defgeneric repository-delete-graph (repository-handle graph-designator &key if-does-not-exist)

362

(:documentation "delete the designated graph.

363

    The behavior corresponds to clearing, but the provenance detail is deletion rather than modification.")

364

365

(:method ((repository rdfcache-repository) graph-designator &rest args)

366

(declare (dynamic-extent args))

367

(apply #'repository-delete-graph *transaction* graph-designator args))

368

369

(:method ((transaction rdfcache-transaction) (graph-designator t) &key if-does-not-exist)

370

(typecase graph-designator

371

((or keyword boolean)

372

(or (ecase graph-designator

373

((nil :default)

374

               (when (plusp (repository-pattern-count transaction 0 0 0 rlmdb:*default-context-number*))

375

(sparql-clear (transaction-record transaction)

376

rdfcache:*default-context-number*)

377

                 (setf (transaction-graph-id-deleted transaction rdfcache:*default-context-number*) t)

378

t))

379

((:all t)

380

(let ((%transaction (transaction-record transaction))

381

(count 0))

382

(when (plusp (repository-pattern-count transaction 0 0 0 0))

383

(do-repository-contexts (context :transaction transaction :default t)

384

                                           (sparql-clear %transaction context)

385

                                           (setf (transaction-graph-id-deleted transaction context) t)

386

(incf count)))

387

(plusp count)))

388

(:named

389

(let ((%transaction (transaction-record transaction))

390

(count 0))

391

(do-repository-contexts (context :transaction transaction :default nil)

392

                                         ;; do not clear the default graph implicitly as ':named'

393

(sparql-clear %transaction context)

394

                                         (setf (transaction-graph-id-deleted transaction context) t)

395

(incf count))

396

(plusp count))))

397

(ecase if-does-not-exist

398

(:error (spocq.e::graph-not-found-error

399

:identifier (ecase graph-designator

400

((nil :default) |urn:dydra|:|default|)

401

((:all t) |urn:dydra|:|all|)

402

(:named |urn:dydra|:|named|))

403

:operation 'repository-delete-graph))

404

((nil) nil))))

405

(iri

406

(case graph-designator

407

          (|urn:dydra|:|default| (repository-delete-graph transaction :default :if-does-not-exist if-does-not-exist))

408

          (|urn:dydra|:|named| (repository-delete-graph transaction :named :if-does-not-exist if-does-not-exist))

409

          (|urn:dydra|:|all| (repository-delete-graph transaction :all :if-does-not-exist if-does-not-exist))

410

(t

411

(let ((%transaction (transaction-record transaction))

412

(graph-term-number (repository-object-term-number transaction graph-designator)))

413

(cond ((or (null if-does-not-exist)

414

                        (plusp (repository-pattern-count transaction 0 0 0 graph-term-number)))

415

(setf (transaction-graph-id-deleted transaction graph-term-number) t)

416

(sparql-clear %transaction (iri-lexical-form graph-designator))

417

t)

418

(t

419

(spocq.e::graph-not-found-error :identifier graph-designator

420

                                                    :operation 'repository-delete-graph)))))))

421

(t

422

(ecase if-does-not-exist

423

          (:error (spocq.e::invalid-graph-error :identifier graph-designator :operation 'repository-delete-graph))

424

((nil) nil))))))

425

426

427

(defgeneric repository-load-graph (repository-handle from-location graph-designator)

428

(:documentation "Load statements into the designated graph.

429

If the :default graph is specified, operate on the static default graph, without allowing for

430

the default/named/all option.")

431

432

(:method ((repository rdfcache-repository) from-location graph-designator)

433

(repository-load-graph *transaction* from-location graph-designator))

434

435

(:method ((transaction rdfcache-transaction) (from-location t) graph-designator)

436

(assert-argument-type repository-load-graph from-location iri)

437

(repository-load-graph transaction (spocq.e:string from-location) graph-designator))

438

439

(:method ((transaction rdfcache-transaction) (from-location string) graph-designator)

440

(when (iri-p graph-designator)

441

(let ((graph-term-number (repository-object-term-number transaction graph-designator)))

442

(if (or (not (plusp graph-term-number))

443

                 (zerop (rdfcache-count (transaction-record transaction) graph-term-number 0 0 0)))

444

(setf (transaction-graph-id-created transaction graph-term-number) t)

445

(setf (transaction-graph-id-modified transaction graph-term-number) t))))

446

447

(sparql-load (transaction-record transaction)

448

(graph-management-argument graph-designator)

449

from-location)

450

spocq.a:|true|))

451

452

453

(defgeneric repository-move-graph (repository-handle from-graph to-graph &key if-does-not-exist)

454

(:documentation "Move statements between the designated graphs.

455

Each may be either an iri or the keyword :default.

456

If the :default graph is specified, operate on the static default graph, without allowing for

457

the default/named/all option.

458

    If the destination named graph does not yet exist, record its creation. Otherwise just note modification.

459

If the from--graph does not exist, signal an error.")

460

461

(:method ((repository rdfcache-repository) from-graph to-graph &rest args)

462

(declare (dynamic-extent args))

463

(apply #'repository-move-graph *transaction* from-graph to-graph args))

464

465

(:method ((transaction rdfcache-transaction) from-graph to-graph &rest args)

466

(declare (dynamic-extent args))

467

(apply #'repository-binary-graph-operation *transaction* from-graph to-graph 'sparql-move args)))

468

469

470

;;;

471

;;; statistics

472

473

(defun initialize-statistics (&key query repository pathname)

474

"Cache initial selectivity statistics for a repository. Allow as background everything

475

from a single query's sse form, to a directory of query documents."

476

477

(cond (query

478

(with-task-environment (:task query :normal-disposition :abort)

479

(repository-initialize-statistics (or repository (task-repository query))

480

                                              (expression-pattern-statements (query-sse-expression query)))))

481

((and repository pathname)

482

(setf repository (repository repository))

483

(unless (pathname-name pathname)

484

(setf pathname (make-pathname :name :wild :type "rq" :defaults pathname)))

485

(labels ((do-initialize ()

486

(dolist (file-pathname (directory pathname))

487

(let ((expression (handler-case (parse-sparql file-pathname)

488

(error (c)

489

                                                  (log-warn "sparql parse failed: ~a: ~s." c file-pathname)

490

nil))))

491

(when expression

492

                           (handler-case (repository-initialize-statistics repository (expression-pattern-statements expression))

493

(error (c)

494

                                    (log-warn "sparql statistics failed: ~a: ~s" c expression))))))))

495

(declare (dynamic-extent #'do-initialize))

496

(call-with-revision-transaction #'do-initialize

497

repository

498

                                            (repository-make-transaction repository)

499

:normal-disposition :abort)))

500

(t

501

(error "Either a query or a combined repository and query pathname are required."))))

502

503

(defgeneric repository-initialize-statistics (repository pattern-statements)

504

(:method ((repository rdfcache-repository) (pattern-statements list))

505

(assert-argument-type repository-initialize-statistics *transaction* transaction)

506

(let ((stats (repository-statistics repository))

507

(default-context-term-number (repository-default-context-term-number repository)))

508

(dolist (pattern-statement pattern-statements)

509

(let ((count-pattern (rest pattern-statement)))

510

(unless (gethash count-pattern stats)

511

(setf (gethash count-pattern stats)

512

(ecase (first pattern-statement)

513

(spocq.a:|triple|

514

(destructuring-bind (subject predicate object) count-pattern

515

(with-pattern-term-numbers (subject predicate object)

516

                          (repository-pattern-count *transaction* subject predicate object default-context-term-number))))

517

(spocq.a:|quad|

518

(destructuring-bind (subject predicate object context) count-pattern

519

(with-pattern-term-numbers (context subject predicate object)

520

                          (repository-pattern-count *transaction* subject predicate object context))))))))))))

521

522

;;; on hetzner heltnormalt is 3/594

523

 ;;; (initialize-statistics :repository "3/594" :pathname #p"/home/asdf/imports/heltnormalt/converted/heltnormalt/breaking_news/")

524

;;; (repository-statistics (repository "3/594"))

525

526

;;; metadata

527

528

529

530

531

;;; on dev (repository-revisions (repository "6/1606"))

532

;;; (repository-revisions "statistics/de4.dydra.com")

533

;;; (repository-revisions "statistics/de1.dydra.com")

534

535

;;; manage external records for repository metadata

536

537

538

539

#+(or) ;; superseded by repository-based method

540

(defmethod load-instance-metadata ((instance object-with-persistent-metadata) (metadata t))

541

(with-metadata-bound (metadata)

542

(let ((metadata-pathname (instance-metadata-pathname instance))

543

(*package* (find-package :spocq.i)))

544

;; load a metadata file and then over-ride it with individual files

545

(load-configuration metadata-pathname)

546

(loop with metadata-file-name = (pathname-name metadata-pathname)

547

               for pathname in (directory (make-pathname :name :wild :defaults metadata-pathname))

548

for name = (pathname-name pathname)

549

for key = (intern (string-upcase (substitute #\- #\_ name)) :keyword)

550

               unless (string-equal metadata-file-name name :end2 (min (length name) (length metadata-file-name)))

551

when (configuration-setting-p key)

552

do (handler-case (let ((setting (read-file pathname)))

553

(when (plusp (length setting))

554

                                    (setf (configuration-parameter key) setting)))

555

(error (c) (log-warn "load-instance-metadata: ~s: ~a" pathname c)))))

556

*metadata*))

557

558

559

(defmethod read-instance-metadata-statements ((repository repository))

560

;; retrieve metadata statements respective the repository's _site_ id

561

;; as opposed to its _host_id

562

(cond ((string-equal "system" (repository-name repository))

563

;; no metadata

564

nil)

565

(t

566

(let* ((account (repository-account repository))

567

(account-identifier (account-identifier account))

568

(repository-identifier (repository-identifier repository))

569

(system-repository-id *system-repository-id*)

570

(account-repository-id (instance-repository-id repository)))

571

(flet ((match-field (context subject predicate object)

572

(repository-match-field *transaction* context subject predicate object)))

573

(append (with-open-transaction (system-repository-id)

574

(match-field account-identifier repository-identifier '?::p '?::o))

575

(with-open-transaction (account-repository-id :if-does-not-exist :create)

576

                        (append (match-field |urn:dydra|:|default| repository-identifier '?::p '?::o)

577

                                (match-field repository-identifier '?::s '?::p '?::o)))))))))

578

579

(defmethod initialize-instance-metadata-statements ((repository repository))

580

(initialize-repository-metadata repository))

581

582

583

584

585

586

587

;;; (pprint-sse (read-instance-metadata-statements (repository "james/test" :account (account "james"))))

588

589

590

591

(defgeneric repository-id-match-p (repository pattern)

592

   (:documentation "given a repository designator and a pattern for repository identifiers, return true iff the

593

id pattern matches the designated repository's id.

594

REPOSITORY : (or repository string uri) : a repository designator

595

PATTERN : (or string function) : a regular expression string or its compiled predicate

596

VALUE : boolean")

597

#+(or)

598

(:method :around ((id t) (pattern t))

599

t)

600

601

(:method ((repository-id string) (pattern null))

602

nil)

603

(:method ((repository repository) (pattern t))

604

(repository-id-match-p (repository-id repository) pattern))

605

(:method ((repository-id string) (pattern function))

606

(cl-ppcre:scan pattern repository-id))

607

(:method ((test-id string) (pattern string))

608

(cl-ppcre:scan pattern test-id)))

609