Coverage report: /development/source/library/org/datagraph/spocq-shard/src/extensions/utilities.lisp

KindCoveredAll%
expression061 0.0
branch00nil
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.server.implementation; -*-
2
 ;;;  Copyright 2013 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved
3
 
4
 (in-package :org.datagraph.spocq.implementation)
5
 
6
 (:documentation "extensions utilities"
7
 
8
 "Implement support operators for the extension modules
9
 - mapping between request host/authority and the target repository id
10
 ")
11
 
12
 ;;; (load "/development/source/library/org/datagraph/spocq/src/server/utilities.lisp")
13
 
14
 (defparameter *host-repository-id-cache* (make-hash-table :test #'equalp))
15
 
16
 
17
 (defun host-repository-id (host-name &key (if-does-not-exist :error))
18
   (or (gethash host-name *host-repository-id-cache*)
19
       (let ((repository-url (caar (run-sparql-internal `(spocq.a:|select|
20
                                                         (spocq.a:|graph| ?::account
21
                                                                  (spocq.a:|bgp|
22
                                                                           (spocq.a:|triple| ?::repo |rdf|:|type| |urn:dydra|:|Repository|)
23
                                                                           (spocq.a:|triple| ?::repo |urn:dydra|:|host| ,host-name)))
24
                                                         (?::repo))
25
                                               :repository-id *system-repository-id*
26
                                               :agent (system-agent)))))
27
         (if repository-url
28
             (let* ((repository-path (reverse (split-string (iri-lexical-form repository-url) #\/)))
29
                    (repository-id (make-repository-id :account-name (third repository-path) :repository-name (first repository-path))))
30
               (setf (gethash host-name *host-repository-id-cache*) repository-id))
31
             (ecase if-does-not-exist
32
               (:error (error "No repository defined for host: ~s" host-name))
33
               ((nil) nil))))))
34
 ;;; (clrhash *host-repository-id-cache*)
35
 ;;; (host-repository-id "ldp.stage.dydra.com")
36
 
37
 (defgeneric report-virtual-repository-hosts (destination &key upstream-host repository)
38
   (:method ((destination pathname) &rest args)
39
     (with-open-file (stream destination :direction :output :if-does-not-exist :create :if-exists :supersede)
40
       (apply #'report-virtual-repository-hosts stream args)))
41
   (:method ((destination stream) &key (upstream-host "spocq-ldp") (repository *system-repository-id*))
42
     (loop for external-host in (report-virtual-repository-hosts nil :repository repository)
43
       count external-host
44
       do (format destination "~&~a ~a;~%" external-host upstream-host)))
45
   (:method ((destination null) &key (repository *system-repository-id*) &allow-other-keys)
46
     (with-accounting
47
         (loop for (external-host)
48
           in (run-sparql-internal `(spocq.a:|distinct|
49
                                    (spocq.a:|select|
50
                                             (spocq.a:|graph| ?::account
51
                                                      (spocq.a:|bgp|
52
                                                               (spocq.a:|triple| ?::repo |rdf|:|type| |urn:dydra|:|Repository|)
53
                                                               (spocq.a:|triple| ?::repo |urn:dydra|:|host| ?::host)))
54
                                             (?::host)))
55
                          :repository-id repository
56
                          :agent (system-agent))
57
           collect external-host))))
58
 
59
 ;;; (report-virtual-repository-hosts #p"/tmp/vhosts.txt" :upstream-host "spocq-ldp")
60
 ;;; (report-virtual-repository-hosts nil :upstream-host "spocq-ldp")